mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-12-23 12:57:20 +01:00
10209 lines
366 KiB
Org Mode
10209 lines
366 KiB
Org Mode
#+TITLE: Jastrow Factor
|
|
|
|
#+SETUPFILE: ../tools/theme.setup
|
|
#+INCLUDE: ../tools/lib.org
|
|
|
|
* Introduction
|
|
|
|
The Jastrow factor depends on the electronic ($\mathbf{r}$) and
|
|
nuclear ($\mathbf{R}$) coordinates. Its defined as $\exp(J(\mathbf{r},\mathbf{R}))$, where
|
|
|
|
\[
|
|
J(\mathbf{r},\mathbf{R}) = J_{\text{eN}}(\mathbf{r},\mathbf{R}) + J_{\text{ee}}(\mathbf{r}) + J_{\text{eeN}}(\mathbf{r},\mathbf{R})
|
|
\]
|
|
|
|
In the following, we use the notations $r_{ij} = |\mathbf{r}_i - \mathbf{r}_j|$ and
|
|
$R_{i\alpha} = |\mathbf{r}_i - \mathbf{R}_\alpha|$.
|
|
|
|
$J_{\text{eN}}$ contains electron-nucleus terms:
|
|
|
|
\[
|
|
J_{\text{eN}}(\mathbf{r},\mathbf{R}) =
|
|
\sum_{\alpha=1}^{N_\text{nucl}} \sum_{i=1}^{N_\text{elec}}
|
|
\frac{a_{1,\alpha}\, g_\alpha(R_{i\alpha})}{1+a_{2,\alpha}\, g_\alpha(R_{i\alpha})} +
|
|
\sum_{p=2}^{N_\text{ord}^a} a_{p+1,\alpha}\, [g_\alpha(R_{i\alpha})]^p - J_{eN}^{\infty \alpha}
|
|
\]
|
|
|
|
$J_{\text{ee}}$ contains electron-electron terms:
|
|
\[
|
|
J_{\text{ee}}(\mathbf{r}) =
|
|
\sum_{i=1}^{N_\text{elec}} \sum_{j=1}^{i-1}
|
|
\frac{b_1\, f(r_{ij})}{1+b_2\, f(r_{ij})} +
|
|
\sum_{p=2}^{N_\text{ord}^b} a_{p+1}\, [f(r_{ij})]^p - J_{ee}^\infty
|
|
\]
|
|
|
|
and $J_{\text{eeN}}$ contains electron-electron-Nucleus terms:
|
|
|
|
\[
|
|
J_{\text{eeN}}(\mathbf{r},\mathbf{R}) =
|
|
\sum_{\alpha=1}^{N_{\text{nucl}}}
|
|
\sum_{i=1}^{N_{\text{elec}}}
|
|
\sum_{j=1}^{i-1}
|
|
\sum_{p=2}^{N_{\text{ord}}}
|
|
\sum_{k=0}^{p-1}
|
|
\sum_{l=0}^{p-k-2\delta_{k,0}}
|
|
c_{lkp\alpha} \left[ f({r}_{ij}) \right]^k
|
|
\left[ \left[ g_\alpha({R}_{i\alpha}) \right]^l + \left[ g_\alpha({R}_{j\alpha}) \right]^l \right]
|
|
\left[ g_\alpha({R}_{i\,\alpha}) \, g_\alpha({R}_{j\alpha}) \right]^{(p-k-l)/2}
|
|
\]
|
|
|
|
$c_{lkp\alpha}$ are non-zero only when $p-k-l$ is even.
|
|
|
|
$f$ and $g$ are scaling function defined as
|
|
|
|
\[
|
|
f(r) = \frac{1-e^{-\kappa\, r}}{\kappa} \text{ and }
|
|
g_\alpha(r) = e^{-\kappa_\alpha\, r}.
|
|
\]
|
|
|
|
The terms $J_{\text{ee}}^\infty$ and $J_{\text{eN}}^\infty$ are shifts to ensure that
|
|
$J_{\text{ee}}$ and $J_{\text{eN}}$ have an asymptotic value of zero.
|
|
|
|
* Headers :noexport:
|
|
#+begin_src elisp :noexport :results none
|
|
(org-babel-lob-ingest "../tools/lib.org")
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func)
|
|
#ifndef QMCKL_JASTROW_HPF
|
|
#define QMCKL_JASTROW_HPF
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_type)
|
|
#ifndef QMCKL_JASTROW_HPT
|
|
#define QMCKL_JASTROW_HPT
|
|
#include <stdbool.h>
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval c_test) :noweb yes
|
|
#include "qmckl.h"
|
|
#include <assert.h>
|
|
#include <math.h>
|
|
#ifdef HAVE_CONFIG_H
|
|
#include "config.h"
|
|
#endif
|
|
|
|
#include <stdio.h>
|
|
#include "n2.h"
|
|
|
|
int main() {
|
|
qmckl_context context;
|
|
context = qmckl_context_create();
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval c)
|
|
#ifdef HAVE_CONFIG_H
|
|
#include "config.h"
|
|
#endif
|
|
|
|
#ifdef HAVE_STDINT_H
|
|
#include <stdint.h>
|
|
#elif HAVE_INTTYPES_H
|
|
#include <inttypes.h>
|
|
#endif
|
|
|
|
#include <stdlib.h>
|
|
#include <string.h>
|
|
#include <stdbool.h>
|
|
#include <assert.h>
|
|
#include <math.h>
|
|
|
|
|
|
#include <stdio.h>
|
|
|
|
#include "qmckl.h"
|
|
#include "qmckl_context_private_type.h"
|
|
#include "qmckl_memory_private_type.h"
|
|
#include "qmckl_memory_private_func.h"
|
|
#include "qmckl_jastrow_private_func.h"
|
|
#include "qmckl_jastrow_private_type.h"
|
|
|
|
#ifdef HAVE_CUBLAS_OFFLOAD
|
|
#include "cublas_v2.h"
|
|
#endif
|
|
|
|
|
|
#+end_src
|
|
|
|
* Context
|
|
:PROPERTIES:
|
|
:Name: qmckl_jastrow
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
The following data stored in the context:
|
|
|
|
#+NAME: qmckl_jastrow_args
|
|
| Variable | Type | In/Out | Description |
|
|
|---------------------------+---------------------------------------+--------+-------------------------------------------------------------------|
|
|
| ~uninitialized~ | ~int32_t~ | in | Keeps bits set for uninitialized data |
|
|
| ~rescale_factor_ee~ | ~double~ | in | The distance scaling factor |
|
|
| ~rescale_factor_en~ | ~double[type_nucl_num]~ | in | The distance scaling factor |
|
|
| ~aord_num~ | ~int64_t~ | in | The number of a coeffecients |
|
|
| ~bord_num~ | ~int64_t~ | in | The number of b coeffecients |
|
|
| ~cord_num~ | ~int64_t~ | in | The number of c coeffecients |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of Nuclei types |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of types of Nuclei |
|
|
| ~a_vector~ | ~double[aord_num + 1][type_nucl_num]~ | in | a polynomial coefficients |
|
|
| ~b_vector~ | ~double[bord_num + 1]~ | in | b polynomial coefficients |
|
|
| ~c_vector~ | ~double[cord_num][type_nucl_num]~ | in | c polynomial coefficients |
|
|
| ~factor_ee~ | ~double[walker.num]~ | out | Jastrow factor: electron-electron part |
|
|
| ~factor_ee_date~ | ~uint64_t~ | out | Jastrow factor: electron-electron part |
|
|
| ~factor_en~ | ~double[walker.num]~ | out | Jastrow factor: electron-nucleus part |
|
|
| ~factor_en_date~ | ~uint64_t~ | out | Jastrow factor: electron-nucleus part |
|
|
| ~factor_een~ | ~double[walker.num]~ | out | Jastrow factor: electron-electron-nucleus part |
|
|
| ~factor_een_date~ | ~uint64_t~ | out | Jastrow factor: electron-electron-nucleus part |
|
|
| ~factor_ee_deriv_e~ | ~double[4][nelec][walker.num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part |
|
|
| ~factor_ee_deriv_e_date~ | ~uint64_t~ | out | Keep track of the date for the derivative |
|
|
| ~factor_en_deriv_e~ | ~double[4][nelec][walker.num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part |
|
|
| ~factor_en_deriv_e_date~ | ~uint64_t~ | out | Keep track of the date for the en derivative |
|
|
| ~factor_een_deriv_e~ | ~double[4][nelec][walker.num]~ | out | Derivative of the Jastrow factor: electron-electron-nucleus part |
|
|
| ~factor_een_deriv_e_date~ | ~uint64_t~ | out | Keep track of the date for the een derivative |
|
|
|
|
computed data:
|
|
|
|
| Variable | Type | In/Out |
|
|
|-------------------------------------+-------------------------------------------------------------------+---------------------------------------------------------------------------------------------------------|
|
|
| ~dim_c_vector~ | ~int64_t~ | Number of unique C coefficients |
|
|
| ~dim_c_vector_date~ | ~uint64_t~ | Number of unique C coefficients |
|
|
| ~asymp_jasa~ | ~double[type_nucl_num]~ | Asymptotic component |
|
|
| ~asymp_jasa_date~ | ~uint64_t~ | Ladt modification of the asymptotic component |
|
|
| ~asymp_jasb~ | ~double[2]~ | Asymptotic component (up- or down-spin) |
|
|
| ~asymp_jasb_date~ | ~uint64_t~ | Ladt modification of the asymptotic component |
|
|
| ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | vector of non-zero coefficients |
|
|
| ~c_vector_full_date~ | ~uint64_t~ | Keep track of changes here |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | Transform l,k,p, and m into consecutive indices |
|
|
| ~lkpm_combined_index_date~ | ~uint64_t~ | Transform l,k,p, and m into consecutive indices |
|
|
| ~tmp_c~ | ~double[walker.num][cord_num][cord_num+1][nucl_num][elec_num]~ | vector of non-zero coefficients |
|
|
| ~dtmp_c~ | ~double[walker.num][elec_num][4][nucl_num][cord_num+1][cord_num]~ | vector of non-zero coefficients |
|
|
| ~ee_distance_rescaled~ | ~double[walker.num][num][num]~ | Electron-electron rescaled distances |
|
|
| ~ee_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances |
|
|
| ~ee_distance_rescaled_deriv_e~ | ~double[walker.num][4][num][num]~ | Electron-electron rescaled distances derivatives |
|
|
| ~ee_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives |
|
|
| ~en_distance_rescaled~ | ~double[walker.num][nucl_num][num]~ | Electron-nucleus distances |
|
|
| ~en_distance_rescaled_date~ | ~uint64_t~ | Last modification date of the electron-electron distances |
|
|
| ~en_distance_rescaled_deriv_e~ | ~double[walker.num][4][nucl_num][num]~ | Electron-electron rescaled distances derivatives |
|
|
| ~en_distance_rescaled_deriv_e_date~ | ~uint64_t~ | Last modification date of the electron-electron distance derivatives |
|
|
| ~een_rescaled_n~ | ~double[walker.num][cord_num+1][nucl_num][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord |
|
|
| ~een_rescaled_n_date~ | ~uint64_t~ | Keep track of the date of creation |
|
|
| ~een_rescaled_e_deriv_e~ | ~double[walker.num][cord_num+1][elec_num][4][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons |
|
|
| ~een_rescaled_e_deriv_e_date~ | ~uint64_t~ | Keep track of the date of creation |
|
|
| ~een_rescaled_n_deriv_e~ | ~double[walker.num][cord_num+1][nucl_num][4][elec_num]~ | The electron-electron rescaled distances raised to the powers defined by cord derivatives wrt electrons |
|
|
| ~een_rescaled_n_deriv_e_date~ | ~uint64_t~ | Keep track of the date of creation |
|
|
|
|
#+NAME: jastrow_data
|
|
#+BEGIN_SRC python :results none :exports none
|
|
import numpy as np
|
|
|
|
# For H2O we have the following data:
|
|
elec_num = 10
|
|
nucl_num = 2
|
|
up_num = 5
|
|
down_num = 5
|
|
nucl_coord = np.array([ [0.000000, 0.000000 ],
|
|
[0.000000, 0.000000 ],
|
|
[0.000000, 2.059801 ] ])
|
|
|
|
elec_coord = np.array( [[[-0.250655104764153 , 0.503070975550133 , -0.166554344502303],
|
|
[-0.587812193472177 , -0.128751981129274 , 0.187773606533075],
|
|
[ 1.61335569047166 , -0.615556732874863 , -1.43165470979934 ],
|
|
[-4.901239896295210E-003 , -1.120440036458986E-002 , 1.99761909330422 ],
|
|
[ 0.766647499681200 , -0.293515395797937 , 3.66454589201239 ],
|
|
[-0.127732483187947 , -0.138975497694196 , -8.669850480215846E-002],
|
|
[-0.232271834949124 , -1.059321673434182E-002 , -0.504862241464867],
|
|
[ 1.09360863531826 , -2.036103063808752E-003 , -2.702796910818986E-002],
|
|
[-0.108090166832043 , 0.189161729653261 , 2.15398313919894],
|
|
[ 0.397978144318712 , -0.254277292595981 , 2.54553335476344]]])
|
|
|
|
ee_distance_rescaled = np.array([
|
|
[ 0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.550227800352402, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.919155060185168, 0.937695909123175, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.893325429242815, 0.851181978173561, 0.978501685226877,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.982457268305353, 0.976125002619471, 0.994349933143149,
|
|
0.844077311588328, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.482407528408731, 0.414816073699124, 0.894716035479343,
|
|
0.876540187084407, 0.978921170036895, 0.000000000000000,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.459541909660400, 0.545007215761510, 0.883752955884551,
|
|
0.918958134888791, 0.986386936267237, 0.362209822236419,
|
|
0.000000000000000, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.763732576854455, 0.817282762358449, 0.801802919535959,
|
|
0.900089095449775, 0.975704636491453, 0.707836537586060,
|
|
0.755705808346586, 0.000000000000000, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.904249454052971, 0.871097965261373, 0.982717262706270,
|
|
0.239901207363622, 0.836519456769083, 0.896135326270534,
|
|
0.930694340243023, 0.917708540815567, 0.000000000000000,
|
|
0.000000000000000 ],
|
|
[ 0.944400908070716, 0.922589018494961, 0.984615718580670,
|
|
0.514328661540623, 0.692362267147064, 0.931894098453677,
|
|
0.956034127544344, 0.931221472309472, 0.540903688625053,
|
|
0.000000000000000 ]])
|
|
|
|
en_distance_rescaled = np.transpose(np.array([
|
|
[ 0.443570948411811 , 0.467602196999105 , 0.893870160799932 ,
|
|
0.864347190364447 , 0.976608182392358 , 0.187563183468210 ,
|
|
0.426404699872689 , 0.665107090128166 , 0.885246991424583 ,
|
|
0.924902909715270 ],
|
|
[ 0.899360150637444 , 0.860035135365386 , 0.979659405613798 ,
|
|
6.140678415933776E-002, 0.835118398056681 , 0.884071658981068 ,
|
|
0.923860000907362 , 0.905203414522289 , 0.211286300932359 ,
|
|
0.492104840907350 ]]))
|
|
|
|
# symmetrize it
|
|
for i in range(elec_num):
|
|
for j in range(elec_num):
|
|
ee_distance_rescaled[i][j] = ee_distance_rescaled[j][i]
|
|
|
|
# For N2, we have the following data:
|
|
type_nucl_num = 1
|
|
aord_num = 5
|
|
bord_num = 5
|
|
cord_num = 5
|
|
dim_c_vector= 23
|
|
type_nucl_vector = [ 1, 1]
|
|
a_vector = np.array([
|
|
[0.000000000000000E+000],
|
|
[0.000000000000000E+000],
|
|
[-0.380512000000000E+000],
|
|
[-0.157996000000000E+000],
|
|
[-3.155800000000000E-002],
|
|
[2.151200000000000E-002]])
|
|
|
|
b_vector =np.array( [ 0.500000000000000E-000, 0.153660000000000E-000, 6.722620000000000E-002,
|
|
2.157000000000000E-002, 7.309600000000000E-003, 2.866000000000000E-003])
|
|
c_vector = [ 0.571702000000000E-000, -0.514253000000000E-000, -0.513043000000000E-000,
|
|
9.486000000000000E-003, -4.205000000000000E-003, 0.426325800000000E-000,
|
|
8.288150000000000E-002, 5.118600000000000E-003, -2.997800000000000E-003,
|
|
-5.270400000000000E-003, -7.499999999999999E-005, -8.301649999999999E-002,
|
|
1.454340000000000E-002, 5.143510000000000E-002, 9.250000000000000E-004,
|
|
-4.099100000000000E-003, 4.327600000000000E-003, -1.654470000000000E-003,
|
|
2.614000000000000E-003, -1.477000000000000E-003, -1.137000000000000E-003,
|
|
-4.010475000000000E-002, 6.106710000000000E-003 ]
|
|
c_vector_full = [
|
|
[ 0.571702000000000E-000, -0.514253000000000E-000, -0.513043000000000E-000,
|
|
9.486000000000000E-003, -4.205000000000000E-003, 0.426325800000000E-000,
|
|
8.288150000000000E-002, 5.118600000000000E-003, -2.997800000000000E-003,
|
|
-5.270400000000000E-003, -7.499999999999999E-005, -8.301649999999999E-002,
|
|
1.454340000000000E-002, 5.143510000000000E-002, 9.250000000000000E-004,
|
|
-4.099100000000000E-003, 4.327600000000000E-003, -1.654470000000000E-003,
|
|
2.614000000000000E-003, -1.477000000000000E-003, -1.137000000000000E-003,
|
|
-4.010475000000000E-002, 6.106710000000000E-003 ],
|
|
[ 0.571702000000000E-000, -0.514253000000000E-000, -0.513043000000000E-000,
|
|
9.486000000000000E-003, -4.205000000000000E-003, 0.426325800000000E-000,
|
|
8.288150000000000E-002, 5.118600000000000E-003, -2.997800000000000E-003,
|
|
-5.270400000000000E-003, -7.499999999999999E-005, -8.301649999999999E-002,
|
|
1.454340000000000E-002, 5.143510000000000E-002, 9.250000000000000E-004,
|
|
-4.099100000000000E-003, 4.327600000000000E-003, -1.654470000000000E-003,
|
|
2.614000000000000E-003, -1.477000000000000E-003, -1.137000000000000E-003,
|
|
-4.010475000000000E-002, 6.106710000000000E-003 ],
|
|
]
|
|
lkpm_combined_index = [[1 , 1 , 2 , 0],
|
|
[0 , 0 , 2 , 1],
|
|
[1 , 2 , 3 , 0],
|
|
[2 , 1 , 3 , 0],
|
|
[0 , 1 , 3 , 1],
|
|
[1 , 0 , 3 , 1],
|
|
[1 , 3 , 4 , 0],
|
|
[2 , 2 , 4 , 0],
|
|
[0 , 2 , 4 , 1],
|
|
[3 , 1 , 4 , 0],
|
|
[1 , 1 , 4 , 1],
|
|
[2 , 0 , 4 , 1],
|
|
[0 , 0 , 4 , 2],
|
|
[1 , 4 , 5 , 0],
|
|
[2 , 3 , 5 , 0],
|
|
[0 , 3 , 5 , 1],
|
|
[3 , 2 , 5 , 0],
|
|
[1 , 2 , 5 , 1],
|
|
[4 , 1 , 5 , 0],
|
|
[2 , 1 , 5 , 1],
|
|
[0 , 1 , 5 , 2],
|
|
[3 , 0 , 5 , 1],
|
|
[1 , 0 , 5 , 2]]
|
|
|
|
kappa = 1.0
|
|
kappa_inv = 1.0/kappa
|
|
#+END_SRC
|
|
|
|
** Data structure
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_type)
|
|
typedef struct qmckl_jastrow_struct{
|
|
int32_t uninitialized;
|
|
int64_t aord_num;
|
|
int64_t bord_num;
|
|
int64_t cord_num;
|
|
int64_t type_nucl_num;
|
|
uint64_t asymp_jasa_date;
|
|
uint64_t asymp_jasb_date;
|
|
uint64_t tmp_c_date;
|
|
uint64_t dtmp_c_date;
|
|
uint64_t factor_ee_date;
|
|
uint64_t factor_en_date;
|
|
uint64_t factor_een_date;
|
|
uint64_t factor_ee_deriv_e_date;
|
|
uint64_t factor_en_deriv_e_date;
|
|
uint64_t factor_een_deriv_e_date;
|
|
double rescale_factor_ee;
|
|
double* rescale_factor_en;
|
|
int64_t* type_nucl_vector;
|
|
double * a_vector;
|
|
double * b_vector;
|
|
double * c_vector;
|
|
double * asymp_jasa;
|
|
double * asymp_jasb;
|
|
double * factor_ee;
|
|
double * factor_en;
|
|
double * factor_een;
|
|
double * factor_ee_deriv_e;
|
|
double * factor_en_deriv_e;
|
|
double * factor_een_deriv_e;
|
|
int64_t dim_c_vector;
|
|
uint64_t dim_c_vector_date;
|
|
double * c_vector_full;
|
|
uint64_t c_vector_full_date;
|
|
int64_t* lkpm_combined_index;
|
|
uint64_t lkpm_combined_index_date;
|
|
double * tmp_c;
|
|
double * dtmp_c;
|
|
uint64_t ee_distance_rescaled_date;
|
|
uint64_t ee_distance_rescaled_deriv_e_date;
|
|
uint64_t en_distance_rescaled_date;
|
|
uint64_t en_distance_rescaled_deriv_e_date;
|
|
double* ee_distance_rescaled;
|
|
double* ee_distance_rescaled_deriv_e;
|
|
double* en_distance_rescaled;
|
|
double* en_distance_rescaled_deriv_e;
|
|
double * een_rescaled_e;
|
|
double * een_rescaled_n;
|
|
uint64_t een_rescaled_e_date;
|
|
uint64_t een_rescaled_n_date;
|
|
double * een_rescaled_e_deriv_e;
|
|
double * een_rescaled_n_deriv_e;
|
|
uint64_t een_rescaled_e_deriv_e_date;
|
|
uint64_t een_rescaled_n_deriv_e_date;
|
|
bool provided;
|
|
char * type;
|
|
|
|
#ifdef HAVE_HPC
|
|
bool gpu_offload;
|
|
#endif
|
|
} qmckl_jastrow_struct;
|
|
#+end_src
|
|
|
|
|
|
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.
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func)
|
|
qmckl_exit_code qmckl_init_jastrow(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c)
|
|
qmckl_exit_code qmckl_init_jastrow(qmckl_context context) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return false;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
ctx->jastrow.uninitialized = (1 << 10) - 1;
|
|
|
|
/* Default values */
|
|
ctx->jastrow.aord_num = -1;
|
|
ctx->jastrow.bord_num = -1;
|
|
ctx->jastrow.cord_num = -1;
|
|
ctx->jastrow.type_nucl_num = -1;
|
|
ctx->jastrow.dim_c_vector = -1;
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
** Initialization functions
|
|
|
|
To prepare for the Jastrow and its derivative, all the following functions need to be
|
|
called.
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func)
|
|
qmckl_exit_code qmckl_set_jastrow_rescale_factor_ee (qmckl_context context, const double kappa_ee);
|
|
qmckl_exit_code qmckl_set_jastrow_rescale_factor_en (qmckl_context context, const double* kappa_en, const int64_t size_max);
|
|
qmckl_exit_code qmckl_set_jastrow_aord_num (qmckl_context context, const int64_t aord_num);
|
|
qmckl_exit_code qmckl_set_jastrow_bord_num (qmckl_context context, const int64_t bord_num);
|
|
qmckl_exit_code qmckl_set_jastrow_cord_num (qmckl_context context, const int64_t cord_num);
|
|
qmckl_exit_code qmckl_set_jastrow_type_nucl_num (qmckl_context context, const int64_t type_nucl_num);
|
|
qmckl_exit_code qmckl_set_jastrow_type_nucl_vector (qmckl_context context, const int64_t* type_nucl_vector, const int64_t nucl_num);
|
|
qmckl_exit_code qmckl_set_jastrow_a_vector (qmckl_context context, const double * a_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_set_jastrow_b_vector (qmckl_context context, const double * b_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_set_jastrow_c_vector (qmckl_context context, const double * c_vector, const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+NAME:pre2
|
|
#+begin_src c :exports none
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
|
|
if (mask != 0 && !(ctx->jastrow.uninitialized & mask)) {
|
|
printf("%d %d\n", mask, ctx->jastrow.uninitialized );
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALREADY_SET,
|
|
"qmckl_set_jastrow_*",
|
|
NULL);
|
|
}
|
|
#+end_src
|
|
|
|
#+NAME:post2
|
|
#+begin_src c :exports none
|
|
ctx->jastrow.uninitialized &= ~mask;
|
|
ctx->jastrow.provided = (ctx->jastrow.uninitialized == 0);
|
|
if (ctx->jastrow.provided) {
|
|
qmckl_exit_code rc_ = qmckl_finalize_jastrow(context);
|
|
if (rc_ != QMCKL_SUCCESS) return rc_;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
#+end_src
|
|
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_aord_num(qmckl_context context, const int64_t aord_num)
|
|
{
|
|
|
|
int32_t mask = 1 << 0;
|
|
|
|
<<pre2>>
|
|
|
|
if (aord_num < 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_aord_num",
|
|
"aord_num < 0");
|
|
}
|
|
|
|
ctx->jastrow.aord_num = aord_num;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_bord_num(qmckl_context context, const int64_t bord_num)
|
|
{
|
|
|
|
int32_t mask = 1 << 1;
|
|
|
|
<<pre2>>
|
|
|
|
if (bord_num < 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_bord_num",
|
|
"bord_num < 0");
|
|
}
|
|
|
|
ctx->jastrow.bord_num = bord_num;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_cord_num(qmckl_context context, const int64_t cord_num)
|
|
{
|
|
|
|
int32_t mask = 1 << 2;
|
|
|
|
<<pre2>>
|
|
|
|
if (cord_num < 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_cord_num",
|
|
"cord_num < 0");
|
|
}
|
|
|
|
int64_t dim_c_vector = -1;
|
|
qmckl_exit_code rc = qmckl_compute_dim_c_vector(context, cord_num, &dim_c_vector);
|
|
assert (rc == QMCKL_SUCCESS);
|
|
|
|
ctx->jastrow.cord_num = cord_num;
|
|
ctx->jastrow.dim_c_vector = dim_c_vector;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num)
|
|
{
|
|
int32_t mask = 1 << 3;
|
|
|
|
<<pre2>>
|
|
|
|
if (type_nucl_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_type_nucl_num",
|
|
"type_nucl_num < 0");
|
|
}
|
|
|
|
ctx->jastrow.type_nucl_num = type_nucl_num;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_type_nucl_vector(qmckl_context context,
|
|
int64_t const * type_nucl_vector,
|
|
const int64_t nucl_num)
|
|
{
|
|
|
|
int32_t mask = 1 << 4;
|
|
|
|
<<pre2>>
|
|
|
|
int64_t type_nucl_num = ctx->jastrow.type_nucl_num;
|
|
|
|
if (type_nucl_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_set_jastrow_type_nucl_vector",
|
|
"type_nucl_num not initialized");
|
|
}
|
|
|
|
if (type_nucl_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_type_nucl_vector",
|
|
"type_nucl_vector = NULL");
|
|
}
|
|
|
|
if (ctx->jastrow.type_nucl_vector != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.type_nucl_vector);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_set_type_nucl_vector",
|
|
"Unable to free ctx->jastrow.type_nucl_vector");
|
|
}
|
|
}
|
|
|
|
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) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_set_jastrow_type_nucl_vector",
|
|
NULL);
|
|
}
|
|
|
|
memcpy(new_array, type_nucl_vector, mem_info.size);
|
|
|
|
ctx->jastrow.type_nucl_vector = new_array;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_a_vector(qmckl_context context,
|
|
double const * a_vector,
|
|
const int64_t size_max)
|
|
{
|
|
int32_t mask = 1 << 5;
|
|
|
|
<<pre2>>
|
|
|
|
int64_t aord_num = ctx->jastrow.aord_num;
|
|
if (aord_num < 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_set_jastrow_a_vector",
|
|
"aord_num not initialized");
|
|
}
|
|
|
|
int64_t type_nucl_num = ctx->jastrow.type_nucl_num;
|
|
|
|
if (type_nucl_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_set_jastrow_a_vector",
|
|
"type_nucl_num not initialized");
|
|
}
|
|
|
|
if (a_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_a_vector",
|
|
"a_vector = NULL");
|
|
}
|
|
|
|
if (ctx->jastrow.a_vector != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.a_vector);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_set_jastrow_a_vector",
|
|
"Unable to free ctx->jastrow.a_vector");
|
|
}
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = (aord_num + 1) * type_nucl_num * sizeof(double);
|
|
|
|
if (size_max < (aord_num+1)*type_nucl_num ) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_set_jastrow_a_vector",
|
|
"Array too small. Expected (aord_num+1)*type_nucl_num");
|
|
}
|
|
|
|
double* new_array = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if(new_array == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_set_jastrow_coefficient",
|
|
NULL);
|
|
}
|
|
|
|
memcpy(new_array, a_vector, mem_info.size);
|
|
|
|
ctx->jastrow.a_vector = new_array;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_b_vector(qmckl_context context,
|
|
double const * b_vector,
|
|
const int64_t size_max)
|
|
{
|
|
int32_t mask = 1 << 6;
|
|
|
|
<<pre2>>
|
|
|
|
int64_t bord_num = ctx->jastrow.bord_num;
|
|
if (bord_num < 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_set_jastrow_b_vector",
|
|
"bord_num not initialized");
|
|
}
|
|
|
|
if (b_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_b_vector",
|
|
"b_vector = NULL");
|
|
}
|
|
|
|
if (ctx->jastrow.b_vector != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.b_vector);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_set_jastrow_b_vector",
|
|
"Unable to free ctx->jastrow.b_vector");
|
|
}
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = (bord_num + 1) * sizeof(double);
|
|
|
|
if (size_max < (bord_num+1)) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_set_jastrow_b_vector",
|
|
"Array too small. Expected (bord_num+1)");
|
|
}
|
|
|
|
double* new_array = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if(new_array == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_set_jastrow_coefficient",
|
|
NULL);
|
|
}
|
|
|
|
memcpy(new_array, b_vector, mem_info.size);
|
|
|
|
ctx->jastrow.b_vector = new_array;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_c_vector(qmckl_context context,
|
|
double const * c_vector,
|
|
const int64_t size_max)
|
|
{
|
|
int32_t mask = 1 << 7;
|
|
|
|
<<pre2>>
|
|
|
|
int64_t type_nucl_num = ctx->jastrow.type_nucl_num;
|
|
if (type_nucl_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_set_jastrow_c_vector",
|
|
"type_nucl_num not initialized");
|
|
}
|
|
|
|
int64_t dim_c_vector = ctx->jastrow.dim_c_vector;
|
|
if (dim_c_vector < 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_set_jastrow_c_vector",
|
|
"cord_num not initialized");
|
|
}
|
|
|
|
if (c_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_c_vector",
|
|
"c_vector = NULL");
|
|
}
|
|
|
|
if (ctx->jastrow.c_vector != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.c_vector);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_set_jastrow_c_vector",
|
|
"Unable to free ctx->jastrow.c_vector");
|
|
}
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = dim_c_vector * type_nucl_num * sizeof(double);
|
|
|
|
if ((size_t) size_max < mem_info.size/sizeof(double)) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_set_jastrow_c_vector",
|
|
"Array too small. Expected dim_c_vector * type_nucl_num");
|
|
}
|
|
|
|
double* new_array = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if(new_array == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_set_jastrow_coefficient",
|
|
NULL);
|
|
}
|
|
|
|
memcpy(new_array, c_vector, mem_info.size);
|
|
|
|
ctx->jastrow.c_vector = new_array;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_rescale_factor_ee(qmckl_context context,
|
|
const double rescale_factor_ee) {
|
|
|
|
int32_t mask = 1 << 8;
|
|
|
|
<<pre2>>
|
|
|
|
if (rescale_factor_ee <= 0.0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_rescale_factor_ee",
|
|
"rescale_factor_ee <= 0.0");
|
|
}
|
|
|
|
ctx->jastrow.rescale_factor_ee = rescale_factor_ee;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_rescale_factor_en(qmckl_context context,
|
|
const double* rescale_factor_en,
|
|
const int64_t size_max) {
|
|
|
|
int32_t mask = 1 << 9;
|
|
|
|
<<pre2>>
|
|
|
|
if (ctx->jastrow.type_nucl_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_set_jastrow_rescale_factor_en",
|
|
"type_nucl_num not set");
|
|
}
|
|
|
|
|
|
if (rescale_factor_en == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_rescale_factor_en",
|
|
"Null pointer");
|
|
}
|
|
|
|
if (size_max < ctx->jastrow.type_nucl_num) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_set_jastrow_rescale_factor_en",
|
|
"Array too small");
|
|
}
|
|
|
|
|
|
if (ctx->jastrow.rescale_factor_en != NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_set_jastrow_rescale_factor_en",
|
|
"Already set");
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->jastrow.type_nucl_num * sizeof(double);
|
|
ctx->jastrow.rescale_factor_en = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
for (int64_t i=0 ; i<ctx->jastrow.type_nucl_num ; ++i) {
|
|
if (rescale_factor_en[i] <= 0.0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_rescale_factor_en",
|
|
"rescale_factor_en <= 0.0");
|
|
}
|
|
ctx->jastrow.rescale_factor_en[i] = rescale_factor_en[i];
|
|
}
|
|
|
|
<<post2>>
|
|
}
|
|
#+end_src
|
|
|
|
When the required information is completely entered, other data structures are
|
|
computed to accelerate the calculations. The intermediates factors
|
|
are precontracted using BLAS LEVEL 3 operations for an optimal flop count.
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_finalize_jastrow(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_finalize_jastrow(qmckl_context context) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* ----------------------------------- */
|
|
/* Check for the necessary information */
|
|
/* ----------------------------------- */
|
|
|
|
/* Check for the electron data
|
|
1. elec_num
|
|
2. ee_distances_rescaled
|
|
,*/
|
|
if (!(ctx->electron.provided)) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_electron",
|
|
NULL);
|
|
}
|
|
|
|
/* Check for the nucleus data
|
|
1. nucl_num
|
|
2. en_distances_rescaled
|
|
,*/
|
|
if (!(ctx->nucleus.provided)) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_nucleus",
|
|
NULL);
|
|
}
|
|
|
|
/* Decide if the Jastrow if offloaded on GPU or not */
|
|
#if defined(HAVE_HPC) && (defined(HAVE_CUBLAS_OFFLOAD) || defined(HAVE_OPENACC_OFFLOAD) || defined(HAVE_OPENMP_OFFLOAD))
|
|
ctx->jastrow.gpu_offload = true; // ctx->electron.num > 100;
|
|
#endif
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_asymp_jasa(context);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_provide_jastrow_asymp_jasb(context);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_context_touch(context);
|
|
return rc;
|
|
|
|
|
|
}
|
|
#+end_src
|
|
|
|
**** Fortran interface
|
|
|
|
#+begin_src f90 :tangle (eval fh_func) :comments org
|
|
interface
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_rescale_factor_ee (context, &
|
|
kappa_ee) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
double precision, intent(in), value :: kappa_ee
|
|
end function qmckl_set_jastrow_rescale_factor_ee
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_rescale_factor_en (context, &
|
|
kappa_en, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(in) :: kappa_en(size_max)
|
|
end function qmckl_set_jastrow_rescale_factor_en
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_aord_num (context, &
|
|
aord_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: aord_num
|
|
end function qmckl_set_jastrow_aord_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_bord_num (context, &
|
|
bord_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: bord_num
|
|
end function qmckl_set_jastrow_bord_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_cord_num (context, &
|
|
cord_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: cord_num
|
|
end function qmckl_set_jastrow_cord_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_type_nucl_num (context, &
|
|
type_nucl_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: type_nucl_num
|
|
end function qmckl_set_jastrow_type_nucl_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_type_nucl_vector (context, &
|
|
type_nucl_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
integer(c_int64_t), intent(in) :: type_nucl_vector(size_max)
|
|
end function qmckl_set_jastrow_type_nucl_vector
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_a_vector(context, &
|
|
a_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(in) :: a_vector(size_max)
|
|
end function qmckl_set_jastrow_a_vector
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_b_vector(context, &
|
|
b_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(in) :: b_vector(size_max)
|
|
end function qmckl_set_jastrow_b_vector
|
|
|
|
integer(qmckl_exit_code) function qmckl_set_jastrow_c_vector(context, &
|
|
c_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(in) :: c_vector(size_max)
|
|
end function qmckl_set_jastrow_c_vector
|
|
|
|
end interface
|
|
#+end_src
|
|
|
|
** Access functions
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
|
qmckl_exit_code qmckl_get_jastrow_aord_num (qmckl_context context, int64_t* const aord_num);
|
|
qmckl_exit_code qmckl_get_jastrow_bord_num (qmckl_context context, int64_t* const bord_num);
|
|
qmckl_exit_code qmckl_get_jastrow_cord_num (qmckl_context context, int64_t* const bord_num);
|
|
qmckl_exit_code qmckl_get_jastrow_type_nucl_num (qmckl_context context, int64_t* const type_nucl_num);
|
|
qmckl_exit_code qmckl_get_jastrow_type_nucl_vector (qmckl_context context, int64_t* const type_nucl_num, const int64_t size_max);
|
|
qmckl_exit_code qmckl_get_jastrow_a_vector (qmckl_context context, double * const a_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_get_jastrow_b_vector (qmckl_context context, double * const b_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_get_jastrow_c_vector (qmckl_context context, double * const c_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_get_jastrow_rescale_factor_ee (const qmckl_context context, double* const rescale_factor_ee);
|
|
qmckl_exit_code qmckl_get_jastrow_rescale_factor_en (const qmckl_context context, double* const rescale_factor_en, const int64_t size_max);
|
|
#+end_src
|
|
|
|
|
|
Along with these core functions, calculation of the jastrow factor
|
|
requires the following additional information to be set:
|
|
|
|
|
|
When all the data for the AOs have been provided, the following
|
|
function returns ~true~.
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func)
|
|
bool qmckl_jastrow_provided (const qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
bool qmckl_jastrow_provided(const qmckl_context context) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return false;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
return ctx->jastrow.provided;
|
|
}
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_get_jastrow_aord_num (const qmckl_context context, int64_t* const aord_num) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (aord_num == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_aord_num",
|
|
"aord_num is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 0;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.aord_num > 0);
|
|
,*aord_num = ctx->jastrow.aord_num;
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_bord_num (const qmckl_context context, int64_t* const bord_num) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (bord_num == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_bord_num",
|
|
"aord_num is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 1;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.bord_num > 0);
|
|
,*bord_num = ctx->jastrow.bord_num;
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_cord_num (const qmckl_context context, int64_t* const cord_num) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (cord_num == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_cord_num",
|
|
"aord_num is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 2;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.cord_num > 0);
|
|
,*cord_num = ctx->jastrow.cord_num;
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_type_nucl_num (const qmckl_context context, int64_t* const type_nucl_num) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (type_nucl_num == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_type_nucl_num",
|
|
"type_nucl_num is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 3;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.type_nucl_num > 0);
|
|
,*type_nucl_num = ctx->jastrow.type_nucl_num;
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_type_nucl_vector (const qmckl_context context,
|
|
int64_t* const type_nucl_vector,
|
|
const int64_t size_max)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (type_nucl_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_type_nucl_vector",
|
|
"type_nucl_vector is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 4;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.type_nucl_vector != NULL);
|
|
if (size_max < ctx->jastrow.type_nucl_num) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_type_nucl_vector",
|
|
"Array too small. Expected jastrow.type_nucl_num");
|
|
}
|
|
|
|
memcpy(type_nucl_vector, ctx->jastrow.type_nucl_vector, ctx->jastrow.type_nucl_num*sizeof(int64_t));
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_a_vector (const qmckl_context context,
|
|
double * const a_vector,
|
|
const int64_t size_max) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (a_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_a_vector",
|
|
"a_vector is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 5;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.a_vector != NULL);
|
|
int64_t sze = (ctx->jastrow.aord_num + 1)*ctx->jastrow.type_nucl_num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_a_vector",
|
|
"Array too small. Expected (ctx->jastrow.aord_num + 1)*ctx->jastrow.type_nucl_num");
|
|
}
|
|
memcpy(a_vector, ctx->jastrow.a_vector, sze*sizeof(double));
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_b_vector (const qmckl_context context,
|
|
double * const b_vector,
|
|
const int64_t size_max) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (b_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_b_vector",
|
|
"b_vector is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 6;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.b_vector != NULL);
|
|
int64_t sze=ctx->jastrow.bord_num +1;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_b_vector",
|
|
"Array too small. Expected (ctx->jastrow.bord_num + 1)");
|
|
}
|
|
memcpy(b_vector, ctx->jastrow.b_vector, sze*sizeof(double));
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_c_vector (const qmckl_context context,
|
|
double * const c_vector,
|
|
const int64_t size_max) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (c_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_c_vector",
|
|
"c_vector is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 7;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.c_vector != NULL);
|
|
|
|
int64_t dim_c_vector;
|
|
qmckl_exit_code rc = qmckl_get_jastrow_dim_c_vector(context, &dim_c_vector);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
int64_t sze=dim_c_vector * ctx->jastrow.type_nucl_num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_c_vector",
|
|
"Array too small. Expected dim_c_vector * jastrow.type_nucl_num");
|
|
}
|
|
memcpy(c_vector, ctx->jastrow.c_vector, sze*sizeof(double));
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_rescale_factor_ee (const qmckl_context context,
|
|
double* const rescale_factor_ee) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (rescale_factor_ee == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_rescale_factor_ee",
|
|
"rescale_factor_ee is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 8;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
assert (ctx->jastrow.rescale_factor_ee > 0.0);
|
|
|
|
,*rescale_factor_ee = ctx->jastrow.rescale_factor_ee;
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_rescale_factor_en (const qmckl_context context,
|
|
double* const rescale_factor_en,
|
|
const int64_t size_max) {
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (rescale_factor_en == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_rescale_factor_en",
|
|
"rescale_factor_en is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 9;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
if (size_max < ctx->jastrow.type_nucl_num) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_rescale_factor_en",
|
|
"Array to small");
|
|
}
|
|
|
|
assert(ctx->jastrow.rescale_factor_en != NULL);
|
|
for (int64_t i=0 ; i<ctx->jastrow.type_nucl_num ; ++i) {
|
|
rescale_factor_en[i] = ctx->jastrow.rescale_factor_en[i];
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
**** Fortran interface
|
|
|
|
#+begin_src f90 :tangle (eval fh_func) :comments org
|
|
interface
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_rescale_factor_ee (context, &
|
|
kappa_ee) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
double precision, intent(out) :: kappa_ee
|
|
end function qmckl_get_jastrow_rescale_factor_ee
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_rescale_factor_en (context, &
|
|
kappa_en, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: kappa_en(size_max)
|
|
end function qmckl_get_jastrow_rescale_factor_en
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_aord_num (context, &
|
|
aord_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(out) :: aord_num
|
|
end function qmckl_get_jastrow_aord_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_bord_num (context, &
|
|
bord_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(out) :: bord_num
|
|
end function qmckl_get_jastrow_bord_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_cord_num (context, &
|
|
cord_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(out) :: cord_num
|
|
end function qmckl_get_jastrow_cord_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_type_nucl_num (context, &
|
|
type_nucl_num) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(out) :: type_nucl_num
|
|
end function qmckl_get_jastrow_type_nucl_num
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_type_nucl_vector (context, &
|
|
type_nucl_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context), intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
integer(c_int64_t), intent(out) :: type_nucl_vector(size_max)
|
|
end function qmckl_get_jastrow_type_nucl_vector
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_a_vector(context, &
|
|
a_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: a_vector(size_max)
|
|
end function qmckl_get_jastrow_a_vector
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_b_vector(context, &
|
|
b_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: b_vector(size_max)
|
|
end function qmckl_get_jastrow_b_vector
|
|
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_c_vector(context, &
|
|
c_vector, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in) , value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: c_vector(size_max)
|
|
end function qmckl_get_jastrow_c_vector
|
|
|
|
end interface
|
|
#+end_src
|
|
|
|
** Test
|
|
#+begin_src c :tangle (eval c_test)
|
|
/* Reference input data */
|
|
int64_t walk_num = n2_walk_num;
|
|
int64_t elec_num = n2_elec_num;
|
|
int64_t elec_up_num = n2_elec_up_num;
|
|
int64_t elec_dn_num = n2_elec_dn_num;
|
|
int64_t nucl_num = n2_nucl_num;
|
|
double rescale_factor_ee = 1.0;
|
|
double rescale_factor_en[2] = { 1.0, 1.0 };
|
|
double* elec_coord = &(n2_elec_coord[0][0][0]);
|
|
|
|
const double* nucl_charge = n2_charge;
|
|
double* nucl_coord = &(n2_nucl_coord[0][0]);
|
|
int64_t size_max;
|
|
|
|
/* Provide Electron data */
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
assert(!qmckl_electron_provided(context));
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_set_electron_num (context, elec_up_num, elec_dn_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_set_electron_coord (context, 'N', walk_num, elec_coord, walk_num*3*elec_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
double elec_coord2[walk_num*3*elec_num];
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_electron_coord (context, 'N', elec_coord2, walk_num*3*elec_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
for (int64_t i=0 ; i<3*elec_num ; ++i) {
|
|
assert( elec_coord[i] == elec_coord2[i] );
|
|
}
|
|
|
|
|
|
/* Provide Nucleus data */
|
|
|
|
assert(!qmckl_nucleus_provided(context));
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_set_nucleus_num (context, nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(!qmckl_nucleus_provided(context));
|
|
|
|
double nucl_coord2[3*nucl_num];
|
|
|
|
rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*nucl_num);
|
|
assert(rc == QMCKL_NOT_PROVIDED);
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
assert(!qmckl_nucleus_provided(context));
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_nucleus_coord (context, 'N', nucl_coord2, nucl_num*3)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
for (int64_t k=0 ; k<3 ; ++k) {
|
|
for (int64_t i=0 ; i<nucl_num ; ++i) {
|
|
assert( nucl_coord[nucl_num*k+i] == nucl_coord2[3*i+k] );
|
|
}
|
|
}
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_nucleus_coord (context, 'T', nucl_coord2, nucl_num*3)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
for (int64_t i=0 ; i<3*nucl_num ; ++i) {
|
|
assert( nucl_coord[i] == nucl_coord2[i] );
|
|
}
|
|
|
|
double nucl_charge2[nucl_num];
|
|
|
|
rc = qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num);
|
|
assert(rc == QMCKL_NOT_PROVIDED);
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_set_nucleus_charge(context, nucl_charge, nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_nucleus_charge(context, nucl_charge2, nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
for (int64_t i=0 ; i<nucl_num ; ++i) {
|
|
assert( nucl_charge[i] == nucl_charge2[i] );
|
|
}
|
|
assert(qmckl_nucleus_provided(context));
|
|
|
|
#+end_src
|
|
|
|
* Computation
|
|
|
|
The computed data is stored in the context so that it can be reused
|
|
by different kernels. To ensure that the data is valid, for each
|
|
computed data the date of the context is stored when it is computed.
|
|
To know if some data needs to be recomputed, we check if the date of
|
|
the dependencies are more recent than the date of the data to
|
|
compute. If it is the case, then the data is recomputed and the
|
|
current date is stored.
|
|
|
|
** Asymptotic component for \(J_{ee}\)
|
|
|
|
Calculate the asymptotic component ~asymp_jasb~ to be substracted from the final
|
|
electron-electron jastrow factor \(J_{\text{ee}}\). The asymptotic component is calculated
|
|
via the ~b_vector~ and the electron-electron rescale factor ~rescale_factor_ee~.
|
|
|
|
\[
|
|
J_{\text{ee}}^{\infty} = \frac{b_1 \kappa^{-1}}{1 + b_2 \kappa^{-1}}
|
|
\]
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_asymp_jasb(qmckl_context context,
|
|
double* const asymp_jasb,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_asymp_jasb(qmckl_context context,
|
|
double* const asymp_jasb,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_get_jastrow_asymp_jasb",
|
|
NULL);
|
|
}
|
|
|
|
|
|
/* Provided in finalize_jastrow */
|
|
/*
|
|
qmckl_exit_code rc;
|
|
rc = qmckl_provide_jastrow_asymp_jasb(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
*/
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = 2;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_asymp_jasb",
|
|
"Array too small. Expected 2");
|
|
}
|
|
memcpy(asymp_jasb, ctx->jastrow.asymp_jasb, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
**** Fortran interface
|
|
|
|
#+begin_src f90 :tangle (eval fh_func) :comments org
|
|
interface
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_asymp_jasb(context, &
|
|
asymp_jasb, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: asymp_jasb(size_max)
|
|
end function qmckl_get_jastrow_asymp_jasb
|
|
end interface
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_asymp_jasb(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_asymp_jasb(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_provide_jastrow_asymp_jasb",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!ctx->jastrow.provided) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_provide_jastrow_asymp_jasb",
|
|
NULL);
|
|
}
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.asymp_jasb_date) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.asymp_jasb == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = 2 * sizeof(double);
|
|
double* asymp_jasb = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (asymp_jasb == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_asymp_jasb",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.asymp_jasb = asymp_jasb;
|
|
}
|
|
|
|
rc = qmckl_compute_jastrow_asymp_jasb(context,
|
|
ctx->jastrow.bord_num,
|
|
ctx->jastrow.b_vector,
|
|
ctx->jastrow.rescale_factor_ee,
|
|
ctx->jastrow.asymp_jasb);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.asymp_jasb_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_jastrow_asymp_jasb
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_asymp_jasb_args
|
|
| Variable | Type | In/Out | Description |
|
|
|---------------------+----------------------+--------+-------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~bord_num~ | ~int64_t~ | in | Order of the polynomial |
|
|
| ~b_vector~ | ~double[bord_num+1]~ | in | Values of b |
|
|
| ~rescale_factor_ee~ | ~double~ | in | Electron coordinates |
|
|
| ~asymp_jasb~ | ~double[2]~ | out | Asymptotic value |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_jastrow_asymp_jasb_f(context, bord_num, b_vector, rescale_factor_ee, asymp_jasb) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: bord_num
|
|
double precision , intent(in) :: b_vector(bord_num + 1)
|
|
double precision , intent(in) :: rescale_factor_ee
|
|
double precision , intent(out) :: asymp_jasb(2)
|
|
|
|
integer*8 :: i, p
|
|
double precision :: kappa_inv, x, asym_one
|
|
kappa_inv = 1.0d0 / rescale_factor_ee
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (bord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
asym_one = b_vector(1) * kappa_inv / (1.0d0 + b_vector(2) * kappa_inv)
|
|
asymp_jasb(:) = (/asym_one, 0.5d0 * asym_one/)
|
|
|
|
do i = 1, 2
|
|
x = kappa_inv
|
|
do p = 2, bord_num
|
|
x = x * kappa_inv
|
|
asymp_jasb(i) = asymp_jasb(i) + b_vector(p + 1) * x
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_jastrow_asymp_jasb_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_jastrow_asymp_jasb (
|
|
const qmckl_context context,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double rescale_factor_ee,
|
|
double* const asymp_jasb ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT){
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (bord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
const double kappa_inv = 1.0 / rescale_factor_ee;
|
|
const double asym_one = b_vector[0] * kappa_inv / (1.0 + b_vector[1] * kappa_inv);
|
|
asymp_jasb[0] = asym_one;
|
|
asymp_jasb[1] = 0.5 * asym_one;
|
|
|
|
for (int i = 0 ; i <= 1; ++i) {
|
|
double x = kappa_inv;
|
|
for (int p = 1; p < bord_num; ++p){
|
|
x *= kappa_inv;
|
|
asymp_jasb[i] = asymp_jasb[i] + b_vector[p + 1] * x;
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_asymp_jasb_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_jastrow_asymp_jasb (
|
|
const qmckl_context context,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double rescale_factor_ee,
|
|
double* const asymp_jasb );
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+name: asymp_jasb
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
asym_one = b_vector[0] * kappa_inv / (1.0 + b_vector[1]*kappa_inv)
|
|
asymp_jasb = np.array([asym_one, 0.5 * asym_one])
|
|
|
|
for i in range(2):
|
|
x = kappa_inv
|
|
for p in range(1,bord_num):
|
|
x = x * kappa_inv
|
|
asymp_jasb[i] += b_vector[p + 1] * x
|
|
|
|
print("asym_one : ", asym_one)
|
|
print("asymp_jasb[0] : ", asymp_jasb[0])
|
|
print("asymp_jasb[1] : ", asymp_jasb[1])
|
|
#+end_src
|
|
|
|
#+RESULTS: asymp_jasb
|
|
: asym_one : 0.43340325572525706
|
|
: asymp_jasb[0] : 0.5323750557252571
|
|
: asymp_jasb[1] : 0.31567342786262853
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
int64_t type_nucl_num = n2_type_nucl_num;
|
|
int64_t* type_nucl_vector = &(n2_type_nucl_vector[0]);
|
|
int64_t aord_num = n2_aord_num;
|
|
int64_t bord_num = n2_bord_num;
|
|
int64_t cord_num = n2_cord_num;
|
|
double* a_vector = &(n2_a_vector[0][0]);
|
|
double* b_vector = &(n2_b_vector[0]);
|
|
double* c_vector = &(n2_c_vector[0][0]);
|
|
int64_t dim_c_vector=0;
|
|
|
|
assert(!qmckl_jastrow_provided(context));
|
|
|
|
/* Set the data */
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_aord_num(context, aord_num)
|
|
);
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_bord_num(context, bord_num)
|
|
);
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_cord_num(context, cord_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_type_nucl_num(context, type_nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_type_nucl_vector(context, type_nucl_vector, nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_a_vector(context, a_vector,(aord_num+1)*type_nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_b_vector(context, b_vector,(bord_num+1))
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_check(context,
|
|
qmckl_get_jastrow_dim_c_vector(context, &dim_c_vector)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_c_vector(context, c_vector,dim_c_vector*type_nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
double k_ee = 0.;
|
|
double k_en[2] = { 0., 0. };
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_rescale_factor_en(context, rescale_factor_en, type_nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_set_jastrow_rescale_factor_ee(context, rescale_factor_ee)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_jastrow_rescale_factor_ee (context, &k_ee)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(k_ee == rescale_factor_ee);
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_jastrow_rescale_factor_en (context, &(k_en[0]), type_nucl_num)
|
|
);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
for (int i=0 ; i<type_nucl_num ; ++i) {
|
|
assert(k_en[i] == rescale_factor_en[i]);
|
|
}
|
|
|
|
/* Check if Jastrow is properly initialized */
|
|
assert(qmckl_jastrow_provided(context));
|
|
|
|
double asymp_jasb[2];
|
|
rc = qmckl_get_jastrow_asymp_jasb(context, asymp_jasb,2);
|
|
|
|
// calculate asymp_jasb
|
|
assert(fabs(asymp_jasb[0]-0.5323750557252571) < 1.e-12);
|
|
assert(fabs(asymp_jasb[1]-0.31567342786262853) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-electron component \(f_{ee}\)
|
|
|
|
Calculate the electron-electron jastrow component ~factor_ee~ using the ~asymp_jasb~
|
|
componenet and the electron-electron rescaled distances ~ee_distance_rescaled~.
|
|
|
|
\[
|
|
f_{ee} = \sum_{i,j<i} \left[ \frac{ \eta B_0 C_{ij}}{1 - B_1 C_{ij}} + \sum^{nord}_{k}B_k C_{ij}^k \right] - J_{\text{ee}}^{\infty}
|
|
\]
|
|
|
|
$\eta$ is the spin factor, $B$ is the vector of $b$ parameters,
|
|
$C$ is the array of scaled distances.
|
|
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_ee(qmckl_context context,
|
|
double* const factor_ee,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_ee(qmckl_context context,
|
|
double* const factor_ee,
|
|
const int64_t size_max)
|
|
{
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_get_jastrow_factor_ee",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
rc = qmckl_provide_jastrow_factor_ee(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
int64_t sze=ctx->electron.walker.num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_ee",
|
|
"Array too small. Expected walker.num");
|
|
}
|
|
memcpy(factor_ee, ctx->jastrow.factor_ee, sze*sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
**** Fortran interface
|
|
|
|
#+begin_src f90 :tangle (eval fh_func) :comments org
|
|
interface
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_factor_ee (context, &
|
|
factor_ee, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: factor_ee(size_max)
|
|
end function qmckl_get_jastrow_factor_ee
|
|
end interface
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_ee(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_ee(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_provide_jastrow_factor_ee",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!ctx->jastrow.provided) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_provide_jastrow_factor_ee",
|
|
NULL);
|
|
}
|
|
|
|
rc = qmckl_provide_ee_distance_rescaled(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Provided in finalize_jastrow */
|
|
/*
|
|
rc = qmckl_provide_jastrow_asymp_jasb(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
*/
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_ee_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.factor_ee != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.factor_ee);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_jastrow_factor_ee",
|
|
"Unable to free ctx->jastrow.factor_ee");
|
|
}
|
|
ctx->jastrow.factor_ee = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_ee == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walker.num * sizeof(double);
|
|
double* factor_ee = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (factor_ee == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_jastrow_factor_ee",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_ee = factor_ee;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_ee(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->electron.up_num,
|
|
ctx->jastrow.bord_num,
|
|
ctx->jastrow.b_vector,
|
|
ctx->jastrow.ee_distance_rescaled,
|
|
ctx->jastrow.asymp_jasb,
|
|
ctx->jastrow.factor_ee);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.factor_ee_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_ee
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_ee_args
|
|
| Variable | Type | In/Out | Description |
|
|
|------------------------+----------------------------------------+--------+-----------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~up_num~ | ~int64_t~ | in | Number of alpha electrons |
|
|
| ~bord_num~ | ~int64_t~ | in | Number of coefficients |
|
|
| ~b_vector~ | ~double[bord_num+1]~ | in | List of coefficients |
|
|
| ~ee_distance_rescaled~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances |
|
|
| ~asymp_jasb~ | ~double[2]~ | in | Electron-electron distances |
|
|
| ~factor_ee~ | ~double[walk_num]~ | out | Electron-electron distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_ee_f(context, walk_num, elec_num, up_num, bord_num, &
|
|
b_vector, ee_distance_rescaled, asymp_jasb, factor_ee) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num
|
|
double precision , intent(in) :: b_vector(bord_num + 1)
|
|
double precision , intent(in) :: ee_distance_rescaled(elec_num, elec_num, walk_num)
|
|
double precision , intent(in) :: asymp_jasb(2)
|
|
double precision , intent(out) :: factor_ee(walk_num)
|
|
|
|
integer*8 :: i, j, p, ipar, nw
|
|
double precision :: x, power_ser, spin_fact
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (bord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
factor_ee = 0.0d0
|
|
|
|
do nw =1, walk_num
|
|
do j = 1, elec_num
|
|
do i = 1, j - 1
|
|
x = ee_distance_rescaled(i,j,nw)
|
|
power_ser = 0.0d0
|
|
spin_fact = 1.0d0
|
|
ipar = 1
|
|
|
|
do p = 2, bord_num
|
|
x = x * ee_distance_rescaled(i,j,nw)
|
|
power_ser = power_ser + b_vector(p + 1) * x
|
|
end do
|
|
|
|
if(j <= up_num .or. i > up_num) then
|
|
spin_fact = 0.5d0
|
|
ipar = 2
|
|
endif
|
|
|
|
factor_ee(nw) = factor_ee(nw) + spin_fact * b_vector(1) * &
|
|
ee_distance_rescaled(i,j,nw) / &
|
|
(1.0d0 + b_vector(2) * &
|
|
ee_distance_rescaled(i,j,nw)) &
|
|
+ power_ser - asymp_jasb(ipar)
|
|
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_ee_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_factor_ee (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t up_num,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* asymp_jasb,
|
|
double* const factor_ee ) {
|
|
|
|
int ipar;
|
|
double x, x1, spin_fact, power_ser;
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (bord_num < 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
for (int nw = 0; nw < walk_num; ++nw) {
|
|
factor_ee[nw] = 0.0; // put init array here.
|
|
for (int i = 0; i < elec_num; ++i ) {
|
|
for (int j = 0; j < i; ++j) {
|
|
//x = ee_distance_rescaled[j * (walk_num * elec_num) + i * (walk_num) + nw];
|
|
x = ee_distance_rescaled[j + i * elec_num + nw*(elec_num * elec_num)];
|
|
x1 = x;
|
|
power_ser = 0.0;
|
|
spin_fact = 1.0;
|
|
ipar = 0; // index of asymp_jasb
|
|
|
|
for (int p = 1; p < bord_num; ++p) {
|
|
x = x * x1;
|
|
power_ser = power_ser + b_vector[p + 1] * x;
|
|
}
|
|
|
|
if(i < up_num || j >= up_num) {
|
|
spin_fact = 0.5;
|
|
ipar = 1;
|
|
}
|
|
|
|
factor_ee[nw] = factor_ee[nw] + spin_fact * b_vector[0] *
|
|
x1 / (1.0 + b_vector[1] * x1)
|
|
- asymp_jasb[ipar] + power_ser;
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_ee_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_ee (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t up_num,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* asymp_jasb,
|
|
double* const factor_ee );
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
<<asymp_jasb>>
|
|
|
|
factor_ee = 0.0
|
|
for i in range(0,elec_num):
|
|
for j in range(0,i):
|
|
x = ee_distance_rescaled[i][j]
|
|
pow_ser = 0.0
|
|
spin_fact = 1.0
|
|
ipar = 0
|
|
|
|
for p in range(1,bord_num):
|
|
x = x * ee_distance_rescaled[i][j]
|
|
pow_ser = pow_ser + b_vector[p + 1] * x
|
|
|
|
if(i < up_num or j >= up_num):
|
|
spin_fact = 0.5
|
|
ipar = 1
|
|
|
|
factor_ee = factor_ee + spin_fact * b_vector[0] * ee_distance_rescaled[i][j] \
|
|
/ (1.0 + b_vector[1] * ee_distance_rescaled[i][j]) \
|
|
- asymp_jasb[ipar] + pow_ser
|
|
print("factor_ee :",factor_ee)
|
|
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: asym_one : 0.43340325572525706
|
|
: asymp_jasb[0] : 0.5323750557252571
|
|
: asymp_jasb[1] : 0.31567342786262853
|
|
: factor_ee : -4.282760865958113
|
|
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
/* Check if Jastrow is properly initialized */
|
|
assert(qmckl_jastrow_provided(context));
|
|
|
|
double factor_ee[walk_num];
|
|
rc = qmckl_check(context,
|
|
qmckl_get_jastrow_factor_ee(context, factor_ee, walk_num)
|
|
);
|
|
|
|
// calculate factor_ee
|
|
printf("%e\n%e\n\n",factor_ee[0],-4.282760865958113 );
|
|
assert(fabs(factor_ee[0]+4.282760865958113) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-electron component derivative \(f'_{ee}\)
|
|
|
|
Calculate the derivative of the ~factor_ee~ using the ~ee_distance_rescaled~ and
|
|
the electron-electron rescaled distances derivatives ~ee_distance_rescaled_deriv_e~.
|
|
There are four components, the gradient which has 3 components in the \(x, y, z\)
|
|
directions and the laplacian as the last component.
|
|
|
|
# TODO: Add equation
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context,
|
|
double* const factor_ee_deriv_e,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_ee_deriv_e(qmckl_context context,
|
|
double* const factor_ee_deriv_e,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_factor_ee_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walker.num * 4 * ctx->electron.num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_ee_deriv_e",
|
|
"Array too small. Expected 4*walk_num*elec_num");
|
|
}
|
|
|
|
memcpy(factor_ee_deriv_e, ctx->jastrow.factor_ee_deriv_e, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_ee_deriv_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_ee_deriv_e(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_provide_jastrow_factor_ee_deriv_e",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!ctx->jastrow.provided) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_provide_jastrow_factor_ee_deriv_e",
|
|
NULL);
|
|
}
|
|
|
|
/* Check if ee rescaled distance is provided */
|
|
rc = qmckl_provide_ee_distance_rescaled(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if ee rescaled distance deriv e is provided */
|
|
rc = qmckl_provide_ee_distance_rescaled_deriv_e(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_ee_deriv_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.factor_ee_deriv_e != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.factor_ee_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_jastrow_factor_ee_deriv_e",
|
|
"Unable to free ctx->jastrow.factor_ee_deriv_e");
|
|
}
|
|
ctx->jastrow.factor_ee_deriv_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_ee_deriv_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walker.num * 4 * ctx->electron.num * sizeof(double);
|
|
double* factor_ee_deriv_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (factor_ee_deriv_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_jastrow_factor_ee_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_ee_deriv_e = factor_ee_deriv_e;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_ee_deriv_e(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->electron.up_num,
|
|
ctx->jastrow.bord_num,
|
|
ctx->jastrow.b_vector,
|
|
ctx->jastrow.ee_distance_rescaled,
|
|
ctx->jastrow.ee_distance_rescaled_deriv_e,
|
|
ctx->jastrow.factor_ee_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.factor_ee_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_ee_deriv_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_ee_deriv_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------------+-------------------------------------------+--------+-----------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~up_num~ | ~int64_t~ | in | Number of alpha electrons |
|
|
| ~bord_num~ | ~int64_t~ | in | Number of coefficients |
|
|
| ~b_vector~ | ~double[bord_num+1]~ | in | List of coefficients |
|
|
| ~ee_distance_rescaled~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances |
|
|
| ~ee_distance_rescaled_deriv_e~ | ~double[walk_num][4][elec_num][elec_num]~ | in | Electron-electron distances |
|
|
| ~factor_ee_deriv_e~ | ~double[walk_num][4][elec_num]~ | out | Electron-electron distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_ee_deriv_e_doc_f( &
|
|
context, walk_num, elec_num, up_num, bord_num, &
|
|
b_vector, ee_distance_rescaled, ee_distance_rescaled_deriv_e, &
|
|
factor_ee_deriv_e) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, bord_num, up_num
|
|
double precision , intent(in) :: b_vector(bord_num + 1)
|
|
double precision , intent(in) :: ee_distance_rescaled(elec_num, elec_num,walk_num)
|
|
double precision , intent(in) :: ee_distance_rescaled_deriv_e(4,elec_num, elec_num,walk_num) !TODO
|
|
double precision , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer*8 :: i, j, p, nw, ii
|
|
double precision :: x, spin_fact, y
|
|
double precision :: den, invden, invden2, invden3, xinv
|
|
double precision :: lap1, lap2, lap3, third
|
|
double precision, dimension(3) :: pow_ser_g
|
|
double precision, dimension(4) :: dx
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (bord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
factor_ee_deriv_e = 0.0d0
|
|
third = 1.0d0 / 3.0d0
|
|
|
|
do nw =1, walk_num
|
|
do j = 1, elec_num
|
|
do i = 1, elec_num
|
|
x = ee_distance_rescaled(i,j,nw)
|
|
if(abs(x) < 1.0d-18) cycle
|
|
pow_ser_g = 0.0d0
|
|
spin_fact = 1.0d0
|
|
den = 1.0d0 + b_vector(2) * x
|
|
invden = 1.0d0 / den
|
|
invden2 = invden * invden
|
|
invden3 = invden2 * invden
|
|
xinv = 1.0d0 / (x + 1.0d-18)
|
|
|
|
dx(1) = ee_distance_rescaled_deriv_e(1, i, j, nw)
|
|
dx(2) = ee_distance_rescaled_deriv_e(2, i, j, nw)
|
|
dx(3) = ee_distance_rescaled_deriv_e(3, i, j, nw)
|
|
dx(4) = ee_distance_rescaled_deriv_e(4, i, j, nw)
|
|
|
|
if((i .LE. up_num .AND. j .LE. up_num ) .OR. &
|
|
(i .GT. up_num .AND. j .GT. up_num)) then
|
|
spin_fact = 0.5d0
|
|
endif
|
|
|
|
lap1 = 0.0d0
|
|
lap2 = 0.0d0
|
|
lap3 = 0.0d0
|
|
do ii = 1, 3
|
|
x = ee_distance_rescaled(i, j, nw)
|
|
if(abs(x) < 1.0d-18) cycle
|
|
do p = 2, bord_num
|
|
y = p * b_vector(p + 1) * x
|
|
pow_ser_g(ii) = pow_ser_g(ii) + y * dx(ii)
|
|
lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii)
|
|
lap2 = lap2 + y
|
|
x = x * ee_distance_rescaled(i, j, nw)
|
|
end do
|
|
|
|
lap3 = lap3 - 2.0d0 * b_vector(2) * dx(ii) * dx(ii)
|
|
|
|
factor_ee_deriv_e( j, ii, nw) = factor_ee_deriv_e( j, ii, nw) + spin_fact * b_vector(1) * &
|
|
dx(ii) * invden2 + pow_ser_g(ii)
|
|
end do
|
|
|
|
ii = 4
|
|
lap2 = lap2 * dx(ii) * third
|
|
lap3 = lap3 + den * dx(ii)
|
|
lap3 = lap3 * (spin_fact * b_vector(1) * invden3)
|
|
factor_ee_deriv_e( j, ii, nw) = factor_ee_deriv_e( j, ii, nw) + lap1 + lap2 + lap3
|
|
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_ee_deriv_e_doc_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_factor_ee_deriv_e_hpc(
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t up_num,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* ee_distance_rescaled_deriv_e,
|
|
double* const factor_ee_deriv_e ) {
|
|
|
|
double pow_ser_g[3];
|
|
double dx[4];
|
|
double x, spin_fact, y;
|
|
double den, invden, invden2, invden3, xinv;
|
|
double lap1, lap2, lap3, third;
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (bord_num < 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
|
|
for (int nw = 0; nw < walk_num; ++nw) {
|
|
for (int ii = 0; ii < 4; ++ii) {
|
|
for (int j = 0; j < elec_num; ++j) {
|
|
factor_ee_deriv_e[j + ii * elec_num + nw * elec_num * 4] = 0.0;
|
|
}
|
|
}
|
|
}
|
|
|
|
third = 1.0 / 3.0;
|
|
|
|
for (int nw = 0; nw < walk_num; ++nw) {
|
|
for (int i = 0; i < elec_num; ++i) {
|
|
for (int j = 0; j < elec_num; ++j) {
|
|
x = ee_distance_rescaled[j + i * elec_num + nw * elec_num * elec_num];
|
|
if (fabs(x) < 1.0e-18) continue;
|
|
for (int ii = 0; ii < 3; ++ii){
|
|
pow_ser_g[ii] = 0.0;
|
|
}
|
|
spin_fact = 1.0;
|
|
den = 1.0 + b_vector[1] * x;
|
|
invden = 1.0 / den;
|
|
invden2 = invden * invden;
|
|
invden3 = invden2 * invden;
|
|
xinv = 1.0 / (x + 1.0e-18);
|
|
|
|
dx[0] = ee_distance_rescaled_deriv_e[0 \
|
|
+ j * 4 + i * 4 * elec_num \
|
|
+ nw * 4 * elec_num * elec_num];
|
|
dx[1] = ee_distance_rescaled_deriv_e[1 \
|
|
+ j * 4 + i * 4 * elec_num \
|
|
+ nw * 4 * elec_num * elec_num];
|
|
dx[2] = ee_distance_rescaled_deriv_e[2 \
|
|
+ j * 4 + i * 4 * elec_num \
|
|
+ nw * 4 * elec_num * elec_num];
|
|
dx[3] = ee_distance_rescaled_deriv_e[3 \
|
|
+ j * 4 + i * 4 * elec_num \
|
|
+ nw * 4 * elec_num * elec_num];
|
|
|
|
if((i <= (up_num-1) && j <= (up_num-1) ) || (i > (up_num-1) && j > (up_num-1))) {
|
|
spin_fact = 0.5;
|
|
}
|
|
|
|
lap1 = 0.0;
|
|
lap2 = 0.0;
|
|
lap3 = 0.0;
|
|
for (int ii = 0; ii < 3; ++ii) {
|
|
x = ee_distance_rescaled[j + i * elec_num + nw * elec_num * elec_num];
|
|
if (fabs(x) < 1.0e-18) continue;
|
|
for (int p = 2; p < bord_num+1; ++p) {
|
|
y = p * b_vector[(p-1) + 1] * x;
|
|
pow_ser_g[ii] = pow_ser_g[ii] + y * dx[ii];
|
|
lap1 = lap1 + (p - 1) * y * xinv * dx[ii] * dx[ii];
|
|
lap2 = lap2 + y;
|
|
x = x * ee_distance_rescaled[j + i * elec_num + nw * elec_num * elec_num];
|
|
}
|
|
|
|
lap3 = lap3 - 2.0 * b_vector[1] * dx[ii] * dx[ii];
|
|
|
|
factor_ee_deriv_e[i + ii * elec_num + nw * elec_num * 4 ] += \
|
|
+ spin_fact * b_vector[0] * dx[ii] * invden2 \
|
|
+ pow_ser_g[ii] ;
|
|
}
|
|
|
|
int ii = 3;
|
|
lap2 = lap2 * dx[ii] * third;
|
|
lap3 = lap3 + den * dx[ii];
|
|
lap3 = lap3 * (spin_fact * b_vector[0] * invden3);
|
|
factor_ee_deriv_e[i + ii*elec_num + nw * elec_num * 4] += lap1 + lap2 + lap3;
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_ee_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_ee_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t up_num,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* ee_distance_rescaled_deriv_e,
|
|
double* const factor_ee_deriv_e );
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_ee_deriv_e_args,rettyp=get_value("CRetType"),fname="qmckl_compute_factor_ee_deriv_e_doc")
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_ee_deriv_e_doc &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
up_num, &
|
|
bord_num, &
|
|
b_vector, &
|
|
ee_distance_rescaled, &
|
|
ee_distance_rescaled_deriv_e, &
|
|
factor_ee_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: up_num
|
|
integer (c_int64_t) , intent(in) , value :: bord_num
|
|
real (c_double ) , intent(in) :: b_vector(bord_num+1)
|
|
real (c_double ) , intent(in) :: ee_distance_rescaled(elec_num,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: ee_distance_rescaled_deriv_e(elec_num,elec_num,4,walk_num)
|
|
real (c_double ) , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_ee_deriv_e_doc_f
|
|
info = qmckl_compute_factor_ee_deriv_e_doc_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
up_num, &
|
|
bord_num, &
|
|
b_vector, &
|
|
ee_distance_rescaled, &
|
|
ee_distance_rescaled_deriv_e, &
|
|
factor_ee_deriv_e)
|
|
|
|
end function qmckl_compute_factor_ee_deriv_e_doc
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_factor_ee_deriv_e_hpc (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t up_num,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* ee_distance_rescaled_deriv_e,
|
|
double* const factor_ee_deriv_e );
|
|
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_factor_ee_deriv_e_doc (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t up_num,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* ee_distance_rescaled_deriv_e,
|
|
double* const factor_ee_deriv_e );
|
|
#+end_src
|
|
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_factor_ee_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t up_num,
|
|
const int64_t bord_num,
|
|
const double* b_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* ee_distance_rescaled_deriv_e,
|
|
double* const factor_ee_deriv_e ) {
|
|
|
|
#ifdef HAVE_HPC
|
|
return qmckl_compute_factor_ee_deriv_e_hpc(context, walk_num, elec_num, up_num, bord_num, b_vector, ee_distance_rescaled, ee_distance_rescaled_deriv_e, factor_ee_deriv_e );
|
|
#else
|
|
return qmckl_compute_factor_ee_deriv_e_doc(context, walk_num, elec_num, up_num, bord_num, b_vector, ee_distance_rescaled, ee_distance_rescaled_deriv_e, factor_ee_deriv_e );
|
|
#endif
|
|
}
|
|
#+end_src
|
|
|
|
|
|
|
|
|
|
*** Test
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
<<asymp_jasb>>
|
|
|
|
kappa = 1.0
|
|
|
|
elec_coord = np.array(elec_coord)[0]
|
|
elec_dist = np.zeros(shape=(elec_num, elec_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for j in range(elec_num):
|
|
elec_dist[i, j] = np.linalg.norm(elec_coord[i] - elec_coord[j])
|
|
|
|
elec_dist_deriv_e = np.zeros(shape=(4,elec_num, elec_num),dtype=float)
|
|
for j in range(elec_num):
|
|
for i in range(elec_num):
|
|
rij_inv = 1.0 / elec_dist[i, j]
|
|
for ii in range(3):
|
|
elec_dist_deriv_e[ii, i, j] = (elec_coord[j][ii] - elec_coord[i][ii]) * rij_inv
|
|
elec_dist_deriv_e[3, i, j] = 2.0 * rij_inv
|
|
elec_dist_deriv_e[:, j, j] = 0.0
|
|
|
|
ee_distance_rescaled_deriv_e = np.zeros(shape=(4,elec_num,elec_num),dtype=float)
|
|
for j in range(elec_num):
|
|
for i in range(elec_num):
|
|
f = 1.0 - kappa * ee_distance_rescaled[i][j]
|
|
for ii in range(4):
|
|
ee_distance_rescaled_deriv_e[ii][i][j] = elec_dist_deriv_e[ii][i][j]
|
|
ee_distance_rescaled_deriv_e[3][i][j] = ee_distance_rescaled_deriv_e[3][i][j] + \
|
|
(-kappa * ee_distance_rescaled_deriv_e[0][i][j] * ee_distance_rescaled_deriv_e[0][i][j]) + \
|
|
(-kappa * ee_distance_rescaled_deriv_e[1][i][j] * ee_distance_rescaled_deriv_e[1][i][j]) + \
|
|
(-kappa * ee_distance_rescaled_deriv_e[2][i][j] * ee_distance_rescaled_deriv_e[2][i][j])
|
|
for ii in range(4):
|
|
ee_distance_rescaled_deriv_e[ii][i][j] = ee_distance_rescaled_deriv_e[ii][i][j] * f
|
|
|
|
third = 1.0 / 3.0
|
|
factor_ee_deriv_e = np.zeros(shape=(4,elec_num),dtype=float)
|
|
dx = np.zeros(shape=(4),dtype=float)
|
|
pow_ser_g = np.zeros(shape=(4),dtype=float)
|
|
for j in range(elec_num):
|
|
for i in range(elec_num):
|
|
x = ee_distance_rescaled[j][i]
|
|
if abs(x) < 1e-18:
|
|
continue
|
|
pow_ser_g = np.zeros(shape=(4),dtype=float)
|
|
spin_fact = 1.0
|
|
den = 1.0 + b_vector[1] * ee_distance_rescaled[j][i]
|
|
invden = 1.0 / den
|
|
invden2 = invden * invden
|
|
invden3 = invden2 * invden
|
|
xinv = 1.0 / (ee_distance_rescaled[j][i] + 1.0E-18)
|
|
ipar = 1
|
|
|
|
for ii in range(4):
|
|
dx[ii] = ee_distance_rescaled_deriv_e[ii][j][i]
|
|
|
|
if((i <= (up_num-1) and j <= (up_num-1) ) or \
|
|
(i > (up_num-1) and j > (up_num-1))):
|
|
spin_fact = 0.5
|
|
|
|
lap1 = 0.0
|
|
lap2 = 0.0
|
|
lap3 = 0.0
|
|
for ii in range(3):
|
|
x = ee_distance_rescaled[j][i]
|
|
if x < 1e-18:
|
|
continue
|
|
for p in range(2,bord_num+1):
|
|
y = p * b_vector[(p-1) + 1] * x
|
|
pow_ser_g[ii] = pow_ser_g[ii] + y * dx[ii]
|
|
lap1 = lap1 + (p - 1) * y * xinv * dx[ii] * dx[ii]
|
|
lap2 = lap2 + y
|
|
x = x * ee_distance_rescaled[j][i]
|
|
|
|
lap3 = lap3 - 2.0 * b_vector[1] * dx[ii] * dx[ii]
|
|
|
|
factor_ee_deriv_e[ii][j] = factor_ee_deriv_e[ii][j] + spin_fact * b_vector[0] * \
|
|
dx[ii] * invden2 + pow_ser_g[ii]
|
|
|
|
ii = 3
|
|
lap2 = lap2 * dx[ii] * third
|
|
lap3 = lap3 + den * dx[ii]
|
|
lap3 = lap3 * (spin_fact * b_vector[0] * invden3)
|
|
factor_ee_deriv_e[ii][j] = factor_ee_deriv_e[ii][j] + lap1 + lap2 + lap3
|
|
|
|
print("factor_ee_deriv_e[0][0]:",factor_ee_deriv_e[0][0])
|
|
print("factor_ee_deriv_e[1][0]:",factor_ee_deriv_e[1][0])
|
|
print("factor_ee_deriv_e[2][0]:",factor_ee_deriv_e[2][0])
|
|
print("factor_ee_deriv_e[3][0]:",factor_ee_deriv_e[3][0])
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: asym_one : 0.43340325572525706
|
|
: asymp_jasb[0] : 0.5323750557252571
|
|
: asymp_jasb[1] : 0.31567342786262853
|
|
: factor_ee_deriv_e[0][0]: 0.16364894652107934
|
|
: factor_ee_deriv_e[1][0]: -0.6927548119830084
|
|
: factor_ee_deriv_e[2][0]: 0.073267755223968
|
|
: factor_ee_deriv_e[3][0]: 1.5111672803213185
|
|
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
/* Check if Jastrow is properly initialized */
|
|
assert(qmckl_jastrow_provided(context));
|
|
|
|
// calculate factor_ee_deriv_e
|
|
double factor_ee_deriv_e[walk_num][4][elec_num];
|
|
rc = qmckl_get_jastrow_factor_ee_deriv_e(context, &(factor_ee_deriv_e[0][0][0]),walk_num*4*elec_num);
|
|
|
|
// check factor_ee_deriv_e
|
|
assert(fabs(factor_ee_deriv_e[0][0][0]-0.16364894652107934) < 1.e-12);
|
|
assert(fabs(factor_ee_deriv_e[0][1][0]+0.6927548119830084 ) < 1.e-12);
|
|
assert(fabs(factor_ee_deriv_e[0][2][0]-0.073267755223968 ) < 1.e-12);
|
|
assert(fabs(factor_ee_deriv_e[0][3][0]-1.5111672803213185 ) < 1.e-12);
|
|
#+end_src
|
|
|
|
** Asymptotic component for \(J_{eN}\)
|
|
|
|
Calculate the asymptotic component ~asymp_jasa~ to be substracted from the final
|
|
electron-nucleus jastrow factor \(J_{\text{eN}}\). The asymptotic component is calculated
|
|
via the ~a_vector~ and the electron-nucleus rescale factors ~rescale_factor_en~.
|
|
|
|
\[
|
|
J_{\text{en}}^{\infty \alpha} = \frac{a_1 \kappa_\alpha^{-1}}{1 + a_2 \kappa_\alpha^{-1}}
|
|
\]
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_asymp_jasa(qmckl_context context,
|
|
double* const asymp_jasa,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_asymp_jasa(qmckl_context context,
|
|
double* const asymp_jasa,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_get_jastrow_asymp_jasa",
|
|
NULL);
|
|
}
|
|
|
|
|
|
/* Provided in finalize_jastrow */
|
|
/*
|
|
qmckl_exit_code rc;
|
|
rc = qmckl_provide_jastrow_asymp_jasa(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
*/
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->jastrow.type_nucl_num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_asymp_jasa",
|
|
"Array too small. Expected nucleus.num");
|
|
}
|
|
memcpy(asymp_jasa, ctx->jastrow.asymp_jasa, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
**** Fortran interface
|
|
|
|
#+begin_src f90 :tangle (eval fh_func) :comments org
|
|
interface
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_asymp_jasa(context, &
|
|
asymp_jasa, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: asymp_jasa(size_max)
|
|
end function qmckl_get_jastrow_asymp_jasa
|
|
end interface
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_asymp_jasa(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_asymp_jasa(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_provide_jastrow_asymp_jasa",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!ctx->jastrow.provided) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_provide_jastrow_asymp_jasa",
|
|
NULL);
|
|
}
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.asymp_jasa_date) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.asymp_jasa == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->jastrow.type_nucl_num * sizeof(double);
|
|
double* asymp_jasa = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (asymp_jasa == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_asymp_jasa",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.asymp_jasa = asymp_jasa;
|
|
}
|
|
|
|
rc = qmckl_compute_jastrow_asymp_jasa(context,
|
|
ctx->jastrow.aord_num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.a_vector,
|
|
ctx->jastrow.rescale_factor_en,
|
|
ctx->jastrow.asymp_jasa);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.asymp_jasa_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_jastrow_asymp_jasa
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_asymp_jasa_args
|
|
| Variable | Type | In/Out | Description |
|
|
|---------------------+-------------------------------------+--------+----------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~aord_num~ | ~int64_t~ | in | Order of the polynomial |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of nucleus types |
|
|
| ~a_vector~ | ~double[type_nucl_num][aord_num+1]~ | in | Values of a |
|
|
| ~rescale_factor_en~ | ~double[type_nucl_num]~ | in | Electron nucleus distances |
|
|
| ~asymp_jasa~ | ~double[type_nucl_num]~ | out | Asymptotic value |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_jastrow_asymp_jasa_f(context, aord_num, type_nucl_num, a_vector, &
|
|
rescale_factor_en, asymp_jasa) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: aord_num
|
|
integer*8 , intent(in) :: type_nucl_num
|
|
double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num)
|
|
double precision , intent(in) :: rescale_factor_en(type_nucl_num)
|
|
double precision , intent(out) :: asymp_jasa(type_nucl_num)
|
|
|
|
integer*8 :: i, j, p
|
|
double precision :: kappa_inv, x, asym_one
|
|
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (aord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
do i=1,type_nucl_num
|
|
|
|
kappa_inv = 1.0d0 / rescale_factor_en(i)
|
|
|
|
asymp_jasa(i) = a_vector(1,i) * kappa_inv / (1.0d0 + a_vector(2,i) * kappa_inv)
|
|
|
|
x = kappa_inv
|
|
do p = 2, aord_num
|
|
x = x * kappa_inv
|
|
asymp_jasa(i) = asymp_jasa(i) + a_vector(p+1, i) * x
|
|
end do
|
|
|
|
end do
|
|
|
|
end function qmckl_compute_jastrow_asymp_jasa_f
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_asymp_jasa_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_jastrow_asymp_jasa &
|
|
(context, aord_num, type_nucl_num, a_vector, rescale_factor_en, asymp_jasa) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: aord_num
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
real (c_double ) , intent(in) :: a_vector(aord_num+1,type_nucl_num)
|
|
real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num)
|
|
real (c_double ) , intent(out) :: asymp_jasa(type_nucl_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_jastrow_asymp_jasa_f
|
|
info = qmckl_compute_jastrow_asymp_jasa_f &
|
|
(context, aord_num, type_nucl_num, a_vector, rescale_factor_en, asymp_jasa)
|
|
|
|
end function qmckl_compute_jastrow_asymp_jasa
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
/*
|
|
qmckl_exit_code qmckl_compute_jastrow_asymp_jasa (
|
|
const qmckl_context context,
|
|
const int64_t aord_num,
|
|
const int64_t type_nucl_num,
|
|
const double* a_vector,
|
|
double* const rescale_factor_en,
|
|
double* const asymp_jasa ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT){
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (aord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
for (int i = 0 ; i <= type_nucl_num; ++i) {
|
|
const double kappa_inv = 1.0 / rescale_factor_en[i];
|
|
asymp_jasa[i] = a_vector[aord_num*i] * kappa_inv / (1.0 + a_vector[1 + aord_num*i] * kappa_inv);
|
|
|
|
double x = kappa_inv;
|
|
for (int p = 1; p < aord_num; ++p){
|
|
x *= kappa_inv;
|
|
asymp_jasa[i] = asymp_jasa[i] + a_vector[p + 1 + aord_num*i] * x;
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
*/
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_header(table=qmckl_asymp_jasa_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code qmckl_compute_jastrow_asymp_jasa (
|
|
const qmckl_context context,
|
|
const int64_t aord_num,
|
|
const int64_t type_nucl_num,
|
|
const double* a_vector,
|
|
const double* rescale_factor_en,
|
|
double* const asymp_jasa );
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+name: asymp_jasa
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
asymp_jasa = a_vector[0] * kappa_inv / (1.0 + a_vector[1]*kappa_inv)
|
|
x = kappa_inv
|
|
for p in range(1,aord_num):
|
|
x = x * kappa_inv
|
|
asymp_jasa += a_vector[p + 1] * x
|
|
print("asymp_jasa[i] : ", asymp_jasa)
|
|
|
|
#+end_src
|
|
|
|
#+RESULTS: asymp_jasa
|
|
: asymp_jasa[i] : [-0.548554]
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
double asymp_jasa[2];
|
|
rc = qmckl_get_jastrow_asymp_jasa(context, asymp_jasa, type_nucl_num);
|
|
|
|
// calculate asymp_jasb
|
|
printf("%e %e\n", asymp_jasa[0], -0.548554);
|
|
assert(fabs(-0.548554 - asymp_jasa[0]) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-nucleus component \(f_{en}\)
|
|
|
|
Calculate the electron-electron jastrow component ~factor_en~ using the ~a_vector~
|
|
coeffecients and the electron-nucleus rescaled distances ~en_distance_rescaled~.
|
|
|
|
\[
|
|
f_{en} = \sum_{i,j<i} \left\{ \frac{ A_0 C_{ij}}{1 - A_1 C_{ij}} + \sum^{nord}_{k}A_k C_{ij}^k \right\}
|
|
\]
|
|
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_en(qmckl_context context,
|
|
double* const factor_en,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_en(qmckl_context context,
|
|
double* const factor_en,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_get_jastrow_factor_en",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_factor_en(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
int64_t sze=ctx->electron.walker.num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_en",
|
|
"Array too small. Expected walker.num");
|
|
}
|
|
memcpy(factor_en, ctx->jastrow.factor_en, sze*sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
**** Fortran interface
|
|
|
|
#+begin_src f90 :tangle (eval fh_func) :comments org
|
|
interface
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_factor_en (context, &
|
|
factor_en, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: factor_en(size_max)
|
|
end function qmckl_get_jastrow_factor_en
|
|
end interface
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_en(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_en(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_provide_jastrow_factor_en",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!ctx->jastrow.provided) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_provide_jastrow_factor_en",
|
|
NULL);
|
|
}
|
|
|
|
/* Check if en rescaled distance is provided */
|
|
rc = qmckl_provide_en_distance_rescaled(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Provided in finalize_jastrow */
|
|
/*
|
|
rc = qmckl_provide_jastrow_asymp_jasa(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
*/
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_en_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.factor_en != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.factor_en);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_jastrow_factor_en",
|
|
"Unable to free ctx->jastrow.factor_en");
|
|
}
|
|
ctx->jastrow.factor_en = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_en == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walker.num * sizeof(double);
|
|
double* factor_en = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (factor_en == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_jastrow_factor_en",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_en = factor_en;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_en(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.aord_num,
|
|
ctx->jastrow.a_vector,
|
|
ctx->jastrow.en_distance_rescaled,
|
|
ctx->jastrow.asymp_jasa,
|
|
ctx->jastrow.factor_en);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.factor_en_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_en
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_en_args
|
|
| Variable | Type | In/Out | Description |
|
|
|------------------------+----------------------------------------+--------+----------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of unique nuclei |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nucleii |
|
|
| ~aord_num~ | ~int64_t~ | in | Number of coefficients |
|
|
| ~a_vector~ | ~double[aord_num+1][type_nucl_num]~ | in | List of coefficients |
|
|
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | in | Electron-nucleus distances |
|
|
| ~asymp_jasa~ | ~double[type_nucl_num]~ | in | Type of nuclei |
|
|
| ~factor_en~ | ~double[walk_num]~ | out | Electron-nucleus jastrow |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_en_f( &
|
|
context, walk_num, elec_num, nucl_num, type_nucl_num, &
|
|
type_nucl_vector, aord_num, a_vector, &
|
|
en_distance_rescaled, asymp_jasa, factor_en) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num)
|
|
double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num)
|
|
double precision , intent(in) :: asymp_jasa(type_nucl_num)
|
|
double precision , intent(out) :: factor_en(walk_num)
|
|
|
|
integer*8 :: i, a, p, nw
|
|
double precision :: x, power_ser
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (aord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_7
|
|
return
|
|
endif
|
|
|
|
|
|
do nw =1, walk_num
|
|
factor_en(nw) = 0.0d0
|
|
do a = 1, nucl_num
|
|
do i = 1, elec_num
|
|
x = en_distance_rescaled(i, a, nw)
|
|
|
|
factor_en(nw) = factor_en(nw) + a_vector(1, type_nucl_vector(a)) * x / &
|
|
(1.0d0 + a_vector(2, type_nucl_vector(a)) * x) - asymp_jasa(type_nucl_vector(a))
|
|
|
|
do p = 2, aord_num
|
|
x = x * en_distance_rescaled(i, a, nw)
|
|
factor_en(nw) = factor_en(nw) + a_vector(p + 1, type_nucl_vector(a)) * x
|
|
end do
|
|
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_en_f
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_en_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_en &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
aord_num, &
|
|
a_vector, &
|
|
en_distance_rescaled, &
|
|
asymp_jasa, &
|
|
factor_en) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
integer (c_int64_t) , intent(in) , value :: aord_num
|
|
real (c_double ) , intent(in) :: a_vector(type_nucl_num,aord_num+1)
|
|
real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
|
|
real (c_double ) , intent(in) :: asymp_jasa(type_nucl_num)
|
|
real (c_double ) , intent(out) :: factor_en(walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_en_f
|
|
info = qmckl_compute_factor_en_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
aord_num, &
|
|
a_vector, &
|
|
en_distance_rescaled, &
|
|
asymp_jasa, &
|
|
factor_en)
|
|
|
|
end function qmckl_compute_factor_en
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
/*
|
|
qmckl_exit_code qmckl_compute_factor_en (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const int64_t aord_num,
|
|
const double* a_vector,
|
|
const double* en_distance_rescaled,
|
|
const double* asymp_jasa,
|
|
double* const factor_en ) {
|
|
|
|
double x, x1, power_ser;
|
|
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
if (type_nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_5;
|
|
}
|
|
|
|
if (type_nucl_vector == NULL) {
|
|
return QMCKL_INVALID_ARG_6;
|
|
}
|
|
|
|
if (aord_num < 0) {
|
|
return QMCKL_INVALID_ARG_7;
|
|
}
|
|
|
|
if (a_vector == NULL) {
|
|
return QMCKL_INVALID_ARG_8;
|
|
}
|
|
|
|
if (en_distance_rescaled == NULL) {
|
|
return QMCKL_INVALID_ARG_9;
|
|
}
|
|
|
|
if (factor_en == NULL) {
|
|
return QMCKL_INVALID_ARG_10;
|
|
}
|
|
|
|
|
|
for (int nw = 0; nw < walk_num; ++nw ) {
|
|
// init array
|
|
factor_en[nw] = 0.0;
|
|
for (int a = 0; a < nucl_num; ++a ) {
|
|
for (int i = 0; i < elec_num; ++i ) {
|
|
x = en_distance_rescaled[i + a * elec_num + nw * (elec_num * nucl_num)];
|
|
x1 = x;
|
|
power_ser = 0.0;
|
|
|
|
for (int p = 2; p < aord_num+1; ++p) {
|
|
x = x * x1;
|
|
power_ser = power_ser + a_vector[p+ (type_nucl_vector[a]-1) * aord_num] * x;
|
|
}
|
|
|
|
factor_en[nw] = factor_en[nw] + a_vector[0 + (type_nucl_vector[a]-1)*aord_num] * x1 / \
|
|
(1.0 + a_vector[1 + (type_nucl_vector[a]-1) * aord_num] * x1) + \
|
|
power_ser;
|
|
|
|
}
|
|
factor_en[nw] = factor_en[nw] + asymp_jasa[type_nucl_vector[a];
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
*/
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_header(table=qmckl_factor_en_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code qmckl_compute_factor_en (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const int64_t aord_num,
|
|
const double* a_vector,
|
|
const double* en_distance_rescaled,
|
|
const double* asymp_jasa,
|
|
double* const factor_en );
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
<<asymp_jasa>>
|
|
|
|
factor_en = 0.0
|
|
for a in range(0,nucl_num):
|
|
for i in range(0,elec_num):
|
|
x = en_distance_rescaled[i][a]
|
|
pow_ser = 0.0
|
|
|
|
for p in range(2,aord_num+1):
|
|
x = x * en_distance_rescaled[i][a]
|
|
pow_ser = pow_ser + a_vector[(p-1) + 1][type_nucl_vector[a]-1] * x
|
|
|
|
factor_en = factor_en + a_vector[0][type_nucl_vector[a]-1] * x \
|
|
/ (1.0 + a_vector[1][type_nucl_vector[a]-1] * x) \
|
|
+ pow_ser
|
|
factor_en -= asymp_jasa[type_nucl_vector[a]-1]
|
|
print("factor_en :",factor_en)
|
|
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: asymp_jasa[i] : [-0.548554]
|
|
: factor_en : 5.1052574308112755
|
|
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
/* Check if Jastrow is properly initialized */
|
|
assert(qmckl_jastrow_provided(context));
|
|
|
|
double factor_en[walk_num];
|
|
rc = qmckl_get_jastrow_factor_en(context, factor_en,walk_num);
|
|
|
|
// calculate factor_en
|
|
assert(fabs(5.1052574308112755 - factor_en[0]) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-nucleus component derivative \(f'_{en}\)
|
|
Calculate the electron-electron jastrow component ~factor_en_deriv_e~ derivative
|
|
with respect to the electron coordinates using the ~en_distance_rescaled~ and ~en_distance_rescaled_deriv_e~ which are already calculated previously.
|
|
|
|
TODO: write equations.
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context,
|
|
double* const factor_en_deriv_e,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_en_deriv_e(qmckl_context context,
|
|
double* const factor_en_deriv_e,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_factor_en_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walker.num * 4 * ctx->electron.num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_en_deriv_e",
|
|
"Array too small. Expected 4*walker.num*elec_num");
|
|
}
|
|
memcpy(factor_en_deriv_e, ctx->jastrow.factor_en_deriv_e, sze*sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_en_deriv_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_factor_en_deriv_e(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_CONTEXT,
|
|
"qmckl_provide_jastrow_factor_en_deriv_e",
|
|
NULL);
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!ctx->jastrow.provided) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_NOT_PROVIDED,
|
|
"qmckl_provide_jastrow_factor_en_deriv_e",
|
|
NULL);
|
|
}
|
|
|
|
/* Check if en rescaled distance is provided */
|
|
rc = qmckl_provide_en_distance_rescaled(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_en_distance_rescaled_deriv_e(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_en_deriv_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.factor_en_deriv_e != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.factor_en_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_jastrow_factor_en_deriv_e",
|
|
"Unable to free ctx->jastrow.factor_en_deriv_e");
|
|
}
|
|
ctx->jastrow.factor_en_deriv_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_en_deriv_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walker.num * 4 * ctx->electron.num * sizeof(double);
|
|
double* factor_en_deriv_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (factor_en_deriv_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_jastrow_factor_en_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_en_deriv_e = factor_en_deriv_e;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_en_deriv_e(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.aord_num,
|
|
ctx->jastrow.a_vector,
|
|
ctx->jastrow.en_distance_rescaled,
|
|
ctx->jastrow.en_distance_rescaled_deriv_e,
|
|
ctx->jastrow.factor_en_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.factor_en_deriv_e_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_en_deriv_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_en_deriv_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------------+-------------------------------------------+--------+---------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of unique nuclei |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nucleii |
|
|
| ~aord_num~ | ~int64_t~ | in | Number of coefficients |
|
|
| ~a_vector~ | ~double[aord_num+1][type_nucl_num]~ | in | List of coefficients |
|
|
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | in | Electron-nucleus distances |
|
|
| ~en_distance_rescaled_deriv_e~ | ~double[walk_num][4][nucl_num][elec_num]~ | in | Electron-nucleus distance derivatives |
|
|
| ~factor_en_deriv_e~ | ~double[walk_num][4][elec_num]~ | out | Electron-nucleus jastrow |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_en_deriv_e_f( &
|
|
context, walk_num, elec_num, nucl_num, type_nucl_num, &
|
|
type_nucl_vector, aord_num, a_vector, &
|
|
en_distance_rescaled, en_distance_rescaled_deriv_e, factor_en_deriv_e) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num)
|
|
double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num)
|
|
double precision , intent(in) :: en_distance_rescaled_deriv_e(4, elec_num, nucl_num, walk_num)
|
|
double precision , intent(out) :: factor_en_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer*8 :: i, a, p, ipar, nw, ii
|
|
double precision :: x, den, invden, invden2, invden3, xinv
|
|
double precision :: y, lap1, lap2, lap3, third
|
|
double precision, dimension(3) :: power_ser_g
|
|
double precision, dimension(4) :: dx
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (aord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_7
|
|
return
|
|
endif
|
|
|
|
factor_en_deriv_e = 0.0d0
|
|
third = 1.0d0 / 3.0d0
|
|
|
|
do nw =1, walk_num
|
|
do a = 1, nucl_num
|
|
do i = 1, elec_num
|
|
x = en_distance_rescaled(i,a,nw)
|
|
if(abs(x) < 1.0d-18) continue
|
|
power_ser_g = 0.0d0
|
|
den = 1.0d0 + a_vector(2, type_nucl_vector(a)) * x
|
|
invden = 1.0d0 / den
|
|
invden2 = invden * invden
|
|
invden3 = invden2 * invden
|
|
xinv = 1.0d0 / x
|
|
|
|
do ii = 1, 4
|
|
dx(ii) = en_distance_rescaled_deriv_e(ii,i,a,nw)
|
|
end do
|
|
|
|
lap1 = 0.0d0
|
|
lap2 = 0.0d0
|
|
lap3 = 0.0d0
|
|
do ii = 1, 3
|
|
x = en_distance_rescaled(i, a, nw)
|
|
do p = 2, aord_num
|
|
y = p * a_vector(p + 1, type_nucl_vector(a)) * x
|
|
power_ser_g(ii) = power_ser_g(ii) + y * dx(ii)
|
|
lap1 = lap1 + (p - 1) * y * xinv * dx(ii) * dx(ii)
|
|
lap2 = lap2 + y
|
|
x = x * en_distance_rescaled(i, a, nw)
|
|
end do
|
|
|
|
lap3 = lap3 - 2.0d0 * a_vector(2, type_nucl_vector(a)) * dx(ii) * dx(ii)
|
|
|
|
factor_en_deriv_e(i, ii, nw) = factor_en_deriv_e(i, ii, nw) + a_vector(1, type_nucl_vector(a)) &
|
|
,* dx(ii) * invden2 &
|
|
+ power_ser_g(ii)
|
|
|
|
end do
|
|
|
|
ii = 4
|
|
lap2 = lap2 * dx(ii) * third
|
|
lap3 = lap3 + den * dx(ii)
|
|
lap3 = lap3 * a_vector(1, type_nucl_vector(a)) * invden3
|
|
factor_en_deriv_e(i, ii, nw) = factor_en_deriv_e(i, ii, nw) + lap1 + lap2 + lap3
|
|
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_en_deriv_e_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_en_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_en_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const int64_t aord_num,
|
|
const double* a_vector,
|
|
const double* en_distance_rescaled,
|
|
const double* en_distance_rescaled_deriv_e,
|
|
double* const factor_en_deriv_e );
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_en_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_en_deriv_e &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
aord_num, &
|
|
a_vector, &
|
|
en_distance_rescaled, &
|
|
en_distance_rescaled_deriv_e, &
|
|
factor_en_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
integer (c_int64_t) , intent(in) , value :: aord_num
|
|
real (c_double ) , intent(in) :: a_vector(type_nucl_num,aord_num+1)
|
|
real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
|
|
real (c_double ) , intent(in) :: en_distance_rescaled_deriv_e(elec_num,nucl_num,4,walk_num)
|
|
real (c_double ) , intent(out) :: factor_en_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_en_deriv_e_f
|
|
info = qmckl_compute_factor_en_deriv_e_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
aord_num, &
|
|
a_vector, &
|
|
en_distance_rescaled, &
|
|
en_distance_rescaled_deriv_e, &
|
|
factor_en_deriv_e)
|
|
|
|
end function qmckl_compute_factor_en_deriv_e
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
kappa = 1.0
|
|
|
|
elec_coord = np.array(elec_coord)[0]
|
|
nucl_coord = np.array(nucl_coord)
|
|
elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for j in range(nucl_num):
|
|
elnuc_dist[i, j] = np.linalg.norm(elec_coord[i] - nucl_coord[:,j])
|
|
|
|
elnuc_dist_deriv_e = np.zeros(shape=(4, elec_num, nucl_num),dtype=float)
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
rij_inv = 1.0 / elnuc_dist[i, a]
|
|
for ii in range(3):
|
|
elnuc_dist_deriv_e[ii, i, a] = (elec_coord[i][ii] - nucl_coord[ii][a]) * rij_inv
|
|
elnuc_dist_deriv_e[3, i, a] = 2.0 * rij_inv
|
|
|
|
en_distance_rescaled_deriv_e = np.zeros(shape=(4,elec_num,nucl_num),dtype=float)
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
f = 1.0 - kappa * en_distance_rescaled[i][a]
|
|
for ii in range(4):
|
|
en_distance_rescaled_deriv_e[ii][i][a] = elnuc_dist_deriv_e[ii][i][a]
|
|
en_distance_rescaled_deriv_e[3][i][a] = en_distance_rescaled_deriv_e[3][i][a] + \
|
|
(-kappa * en_distance_rescaled_deriv_e[0][i][a] * en_distance_rescaled_deriv_e[0][i][a]) + \
|
|
(-kappa * en_distance_rescaled_deriv_e[1][i][a] * en_distance_rescaled_deriv_e[1][i][a]) + \
|
|
(-kappa * en_distance_rescaled_deriv_e[2][i][a] * en_distance_rescaled_deriv_e[2][i][a])
|
|
for ii in range(4):
|
|
en_distance_rescaled_deriv_e[ii][i][a] = en_distance_rescaled_deriv_e[ii][i][a] * f
|
|
|
|
third = 1.0 / 3.0
|
|
factor_en_deriv_e = np.zeros(shape=(4,elec_num),dtype=float)
|
|
dx = np.zeros(shape=(4),dtype=float)
|
|
pow_ser_g = np.zeros(shape=(3),dtype=float)
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
x = en_distance_rescaled[i][a]
|
|
if abs(x) < 1e-18:
|
|
continue
|
|
pow_ser_g = np.zeros(shape=(3),dtype=float)
|
|
den = 1.0 + a_vector[1][type_nucl_vector[a]-1] * x
|
|
invden = 1.0 / den
|
|
invden2 = invden * invden
|
|
invden3 = invden2 * invden
|
|
xinv = 1.0 / (x + 1.0E-18)
|
|
|
|
for ii in range(4):
|
|
dx[ii] = en_distance_rescaled_deriv_e[ii][i][a]
|
|
|
|
lap1 = 0.0
|
|
lap2 = 0.0
|
|
lap3 = 0.0
|
|
for ii in range(3):
|
|
x = en_distance_rescaled[i][a]
|
|
if x < 1e-18:
|
|
continue
|
|
for p in range(2,aord_num+1):
|
|
y = p * a_vector[(p-1) + 1][type_nucl_vector[a]-1] * x
|
|
pow_ser_g[ii] = pow_ser_g[ii] + y * dx[ii]
|
|
lap1 = lap1 + (p - 1) * y * xinv * dx[ii] * dx[ii]
|
|
lap2 = lap2 + y
|
|
x = x * en_distance_rescaled[i][a]
|
|
|
|
lap3 = lap3 - 2.0 * a_vector[1][type_nucl_vector[a]-1] * dx[ii] * dx[ii]
|
|
|
|
factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + a_vector[0][type_nucl_vector[a]-1] * \
|
|
dx[ii] * invden2 + pow_ser_g[ii]
|
|
|
|
ii = 3
|
|
lap2 = lap2 * dx[ii] * third
|
|
lap3 = lap3 + den * dx[ii]
|
|
lap3 = lap3 * (a_vector[0][type_nucl_vector[a]-1] * invden3)
|
|
factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + lap1 + lap2 + lap3
|
|
|
|
print("factor_en_deriv_e[0][0]:",factor_en_deriv_e[0][0])
|
|
print("factor_en_deriv_e[1][0]:",factor_en_deriv_e[1][0])
|
|
print("factor_en_deriv_e[2][0]:",factor_en_deriv_e[2][0])
|
|
print("factor_en_deriv_e[3][0]:",factor_en_deriv_e[3][0])
|
|
|
|
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: factor_en_deriv_e[0][0]: 0.11609919541763383
|
|
: factor_en_deriv_e[1][0]: -0.23301394780804574
|
|
: factor_en_deriv_e[2][0]: 0.17548337641865783
|
|
: factor_en_deriv_e[3][0]: -0.9667363412285741
|
|
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
/* Check if Jastrow is properly initialized */
|
|
assert(qmckl_jastrow_provided(context));
|
|
|
|
// calculate factor_en_deriv_e
|
|
double factor_en_deriv_e[walk_num][4][elec_num];
|
|
rc = qmckl_get_jastrow_factor_en_deriv_e(context, &(factor_en_deriv_e[0][0][0]),walk_num*4*elec_num);
|
|
|
|
// check factor_en_deriv_e
|
|
assert(fabs(factor_en_deriv_e[0][0][0]-0.11609919541763383) < 1.e-12);
|
|
assert(fabs(factor_en_deriv_e[0][1][0]+0.23301394780804574) < 1.e-12);
|
|
assert(fabs(factor_en_deriv_e[0][2][0]-0.17548337641865783) < 1.e-12);
|
|
assert(fabs(factor_en_deriv_e[0][3][0]+0.9667363412285741 ) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-electron rescaled distances ~ee_distance_rescaled~ stores the matrix of the rescaled distances between all
|
|
pairs of electrons:
|
|
|
|
\[
|
|
C_{ij} = \left( 1 - \exp{-\kappa C_{ij}}\right)/\kappa
|
|
\]
|
|
|
|
where \(C_{ij}\) is the matrix of electron-electron distances.
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code qmckl_get_jastrow_ee_distance_rescaled(qmckl_context context, double* const distance_rescaled);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_get_jastrow_ee_distance_rescaled(qmckl_context context, double* const distance_rescaled)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_ee_distance_rescaled(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = ctx->electron.num * ctx->electron.num * ctx->electron.walker.num;
|
|
memcpy(distance_rescaled, ctx->jastrow.ee_distance_rescaled, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_ee_distance_rescaled(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_ee_distance_rescaled(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->electron.walker.point.date > ctx->jastrow.ee_distance_rescaled_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.ee_distance_rescaled != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.ee_distance_rescaled);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_ee_distance_rescaled",
|
|
"Unable to free ctx->jastrow.ee_distance_rescaled");
|
|
}
|
|
ctx->jastrow.ee_distance_rescaled = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.ee_distance_rescaled == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.num * ctx->electron.num *
|
|
ctx->electron.walker.num * sizeof(double);
|
|
double* ee_distance_rescaled = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (ee_distance_rescaled == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_ee_distance_rescaled",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.ee_distance_rescaled = ee_distance_rescaled;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_ee_distance_rescaled(context,
|
|
ctx->electron.num,
|
|
ctx->jastrow.rescale_factor_ee,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.walker.point.coord.data,
|
|
ctx->jastrow.ee_distance_rescaled);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.ee_distance_rescaled_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_ee_distance_rescaled
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_ee_distance_rescaled_args
|
|
| Variable | Type | In/Out | Description |
|
|
|---------------------+----------------------------------------+--------+--------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~rescale_factor_ee~ | ~double~ | in | Factor to rescale ee distances |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates |
|
|
| ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | out | Electron-electron rescaled distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_ee_distance_rescaled_f(context, elec_num, rescale_factor_ee, walk_num, &
|
|
coord, ee_distance_rescaled) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: elec_num
|
|
double precision , intent(in) :: rescale_factor_ee
|
|
integer*8 , intent(in) :: walk_num
|
|
double precision , intent(in) :: coord(elec_num,walk_num,3)
|
|
double precision , intent(out) :: ee_distance_rescaled(elec_num,elec_num,walk_num)
|
|
|
|
integer*8 :: k
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
do k=1,walk_num
|
|
info = qmckl_distance_rescaled(context, 'T', 'T', elec_num, elec_num, &
|
|
coord(1,k,1), elec_num * walk_num, &
|
|
coord(1,k,1), elec_num * walk_num, &
|
|
ee_distance_rescaled(1,1,k), elec_num, rescale_factor_ee)
|
|
if (info /= QMCKL_SUCCESS) then
|
|
exit
|
|
endif
|
|
end do
|
|
|
|
end function qmckl_compute_ee_distance_rescaled_f
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
|
|
qmckl_exit_code qmckl_compute_ee_distance_rescaled (
|
|
const qmckl_context context,
|
|
const int64_t elec_num,
|
|
const double rescale_factor_ee,
|
|
const int64_t walk_num,
|
|
const double* coord,
|
|
double* const ee_distance_rescaled );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_ee_distance_rescaled_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_ee_distance_rescaled &
|
|
(context, elec_num, rescale_factor_ee, walk_num, coord, ee_distance_rescaled) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
real (c_double ) , intent(in) , value :: rescale_factor_ee
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
real (c_double ) , intent(in) :: coord(elec_num,3,walk_num)
|
|
real (c_double ) , intent(out) :: ee_distance_rescaled(elec_num,elec_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_ee_distance_rescaled_f
|
|
info = qmckl_compute_ee_distance_rescaled_f &
|
|
(context, elec_num, rescale_factor_ee, walk_num, coord, ee_distance_rescaled)
|
|
|
|
end function qmckl_compute_ee_distance_rescaled
|
|
#+end_src
|
|
|
|
*** Test
|
|
|
|
#+begin_src python :results output :exports none
|
|
import numpy as np
|
|
|
|
kappa = 1.0
|
|
|
|
elec_1_w1 = np.array( [-0.250655104764153, 0.503070975550133 , -0.166554344502303])
|
|
elec_2_w1 = np.array( [-0.587812193472177, -0.128751981129274 , 0.187773606533075])
|
|
elec_5_w1 = np.array( [-0.127732483187947, -0.138975497694196 , -8.669850480215846E-002])
|
|
elec_6_w1 = np.array( [-0.232271834949124, -1.059321673434182E-002 , -0.504862241464867])
|
|
|
|
print ( "[0][0] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_1_w1-elec_1_w1)) )/kappa )
|
|
print ( "[0][1] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_1_w1-elec_2_w1)) )/kappa )
|
|
print ( "[1][0] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_2_w1-elec_1_w1)) )/kappa )
|
|
print ( "[5][5] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_5_w1-elec_5_w1)) )/kappa )
|
|
print ( "[5][6] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_5_w1-elec_6_w1)) )/kappa )
|
|
print ( "[6][5] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_6_w1-elec_5_w1)) )/kappa )
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: [0][0] : 0.0
|
|
: [0][1] : 0.5502278003524018
|
|
: [1][0] : 0.5502278003524018
|
|
: [5][5] : 0.0
|
|
: [5][6] : 0.3622098222364193
|
|
: [6][5] : 0.3622098222364193
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
|
|
double ee_distance_rescaled[walk_num * elec_num * elec_num];
|
|
rc = qmckl_get_jastrow_ee_distance_rescaled(context, ee_distance_rescaled);
|
|
|
|
// (e1,e2,w)
|
|
// (0,0,0) == 0.
|
|
assert(ee_distance_rescaled[0] == 0.);
|
|
|
|
// (1,0,0) == (0,1,0)
|
|
assert(ee_distance_rescaled[1] == ee_distance_rescaled[elec_num]);
|
|
|
|
// value of (1,0,0)
|
|
assert(fabs(ee_distance_rescaled[1]-0.5502278003524018) < 1.e-12);
|
|
|
|
// (0,0,1) == 0.
|
|
assert(ee_distance_rescaled[5*elec_num + 5] == 0.);
|
|
|
|
// (1,0,1) == (0,1,1)
|
|
assert(ee_distance_rescaled[5*elec_num+6] == ee_distance_rescaled[6*elec_num+5]);
|
|
|
|
// value of (1,0,1)
|
|
assert(fabs(ee_distance_rescaled[5*elec_num+6]-0.3622098222364193) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-electron rescaled distance gradients and Laplacian with respect to electron coords
|
|
|
|
The rescaled distances which is given as $R = (1 - \exp{-\kappa r})/\kappa$
|
|
needs to be perturbed with respect to the electorn coordinates.
|
|
This data is stored in the ~ee_distance_rescaled_deriv_e~ tensor. The
|
|
The first three elements of this three index tensor ~[4][num][num]~ gives the
|
|
derivatives in the x, y, and z directions $dx, dy, dz$ and the last index
|
|
gives the Laplacian $\partial x^2 + \partial y^2 + \partial z^2$.
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code qmckl_get_jastrow_ee_distance_rescaled_deriv_e(qmckl_context context, double* const distance_rescaled_deriv_e);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_get_jastrow_ee_distance_rescaled_deriv_e(qmckl_context context, double* const distance_rescaled_deriv_e)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_ee_distance_rescaled_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = 4 * ctx->electron.num * ctx->electron.num * ctx->electron.walker.num;
|
|
memcpy(distance_rescaled_deriv_e, ctx->jastrow.ee_distance_rescaled_deriv_e, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_ee_distance_rescaled_deriv_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_ee_distance_rescaled_deriv_e(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->electron.walker.point.date > ctx->jastrow.ee_distance_rescaled_deriv_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.ee_distance_rescaled_deriv_e != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.ee_distance_rescaled_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_ee_distance_rescaled_deriv_e",
|
|
"Unable to free ctx->jastrow.ee_distance_rescaled_deriv_e");
|
|
}
|
|
ctx->jastrow.ee_distance_rescaled_deriv_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.ee_distance_rescaled_deriv_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = 4 * ctx->electron.num * ctx->electron.num *
|
|
ctx->electron.walker.num * sizeof(double);
|
|
double* ee_distance_rescaled_deriv_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (ee_distance_rescaled_deriv_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_ee_distance_rescaled_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.ee_distance_rescaled_deriv_e = ee_distance_rescaled_deriv_e;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_ee_distance_rescaled_deriv_e(context,
|
|
ctx->electron.num,
|
|
ctx->jastrow.rescale_factor_ee,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.walker.point.coord.data,
|
|
ctx->jastrow.ee_distance_rescaled_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.ee_distance_rescaled_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_ee_distance_rescaled_deriv_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_ee_distance_rescaled_deriv_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|-----------------------+-------------------------------------------+--------+-------------------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~rescale_factor_ee~ | ~double~ | in | Factor to rescale ee distances |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates |
|
|
| ~ee_distance_deriv_e~ | ~double[walk_num][4][elec_num][elec_num]~ | out | Electron-electron rescaled distance derivatives |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_ee_distance_rescaled_deriv_e_f(context, elec_num, rescale_factor_ee, walk_num, &
|
|
coord, ee_distance_rescaled_deriv_e) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: elec_num
|
|
double precision , intent(in) :: rescale_factor_ee
|
|
integer*8 , intent(in) :: walk_num
|
|
double precision , intent(in) :: coord(elec_num,walk_num,3)
|
|
double precision , intent(out) :: ee_distance_rescaled_deriv_e(4,elec_num,elec_num,walk_num)
|
|
|
|
integer*8 :: k
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
do k=1,walk_num
|
|
info = qmckl_distance_rescaled_deriv_e(context, 'T', 'T', elec_num, elec_num, &
|
|
coord(1,k,1), elec_num*walk_num, &
|
|
coord(1,k,1), elec_num*walk_num, &
|
|
ee_distance_rescaled_deriv_e(1,1,1,k), elec_num, rescale_factor_ee)
|
|
if (info /= QMCKL_SUCCESS) then
|
|
exit
|
|
endif
|
|
end do
|
|
|
|
end function qmckl_compute_ee_distance_rescaled_deriv_e_f
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
|
|
qmckl_exit_code qmckl_compute_ee_distance_rescaled_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t elec_num,
|
|
const double rescale_factor_ee,
|
|
const int64_t walk_num,
|
|
const double* coord,
|
|
double* const ee_distance_rescaled_deriv_e );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_ee_distance_rescaled_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_ee_distance_rescaled_deriv_e &
|
|
(context, elec_num, rescale_factor_ee, walk_num, coord, ee_distance_rescaled_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
real (c_double ) , intent(in) , value :: rescale_factor_ee
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
real (c_double ) , intent(in) :: coord(elec_num,3,walk_num)
|
|
real (c_double ) , intent(out) :: ee_distance_rescaled_deriv_e(4,elec_num,elec_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_ee_distance_rescaled_deriv_e_f
|
|
info = qmckl_compute_ee_distance_rescaled_deriv_e_f &
|
|
(context, elec_num, rescale_factor_ee, walk_num, coord, ee_distance_rescaled_deriv_e)
|
|
|
|
end function qmckl_compute_ee_distance_rescaled_deriv_e
|
|
#+end_src
|
|
|
|
*** Test
|
|
|
|
#+begin_src python :results output :exports none
|
|
import numpy as np
|
|
|
|
# TODO
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
|
|
double ee_distance_rescaled_deriv_e[4 * walk_num * elec_num * elec_num];
|
|
rc = qmckl_get_jastrow_ee_distance_rescaled_deriv_e(context, ee_distance_rescaled_deriv_e);
|
|
|
|
// TODO: Get exact values
|
|
//// (e1,e2,w)
|
|
//// (0,0,0) == 0.
|
|
//assert(ee_distance[0] == 0.);
|
|
//
|
|
//// (1,0,0) == (0,1,0)
|
|
//assert(ee_distance[1] == ee_distance[elec_num]);
|
|
//
|
|
//// value of (1,0,0)
|
|
//assert(fabs(ee_distance[1]-7.152322512964209) < 1.e-12);
|
|
//
|
|
//// (0,0,1) == 0.
|
|
//assert(ee_distance[elec_num*elec_num] == 0.);
|
|
//
|
|
//// (1,0,1) == (0,1,1)
|
|
//assert(ee_distance[elec_num*elec_num+1] == ee_distance[elec_num*elec_num+elec_num]);
|
|
//
|
|
//// value of (1,0,1)
|
|
//assert(fabs(ee_distance[elec_num*elec_num+1]-6.5517646321055665) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-electron-nucleus rescaled distances for each order ~een_rescaled_e~ stores the table of the rescaled distances between all
|
|
pairs of electrons and raised to the power \(p\) defined by ~cord_num~:
|
|
|
|
\[
|
|
C_{ij,p} = \left( 1 - \exp{-\kappa C_{ij}} \right)^p
|
|
\]
|
|
|
|
where \(C_{ij}\) is the matrix of electron-electron distances.
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_e(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_e(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_een_rescaled_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1);
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_een_rescaled_e",
|
|
"Array too small. Expected ctx->electron.num * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1)");
|
|
}
|
|
memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_e(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if ee distance is provided */
|
|
qmckl_exit_code rc = qmckl_provide_ee_distance(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.een_rescaled_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.een_rescaled_e != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.een_rescaled_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_een_rescaled_e",
|
|
"Unable to free ctx->jastrow.een_rescaled_e");
|
|
}
|
|
ctx->jastrow.een_rescaled_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.een_rescaled_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.num * ctx->electron.num *
|
|
ctx->electron.walker.num * (ctx->jastrow.cord_num + 1) * sizeof(double);
|
|
double* een_rescaled_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (een_rescaled_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_een_rescaled_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_e = een_rescaled_e;
|
|
}
|
|
|
|
rc = qmckl_compute_een_rescaled_e(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.rescale_factor_ee,
|
|
ctx->electron.ee_distance,
|
|
ctx->jastrow.een_rescaled_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.een_rescaled_e_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_een_rescaled_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_een_rescaled_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|---------------------+----------------------------------------------------+--------+--------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~rescale_factor_ee~ | ~double~ | in | Factor to rescale ee distances |
|
|
| ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances |
|
|
| ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | out | Electron-electron rescaled distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_een_rescaled_e_doc_f( &
|
|
context, walk_num, elec_num, cord_num, rescale_factor_ee, &
|
|
ee_distance, een_rescaled_e) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: cord_num
|
|
double precision , intent(in) :: rescale_factor_ee
|
|
double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num)
|
|
double precision , intent(out) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
|
|
double precision,dimension(:,:),allocatable :: een_rescaled_e_ij
|
|
double precision :: x
|
|
integer*8 :: i, j, k, l, nw
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
allocate(een_rescaled_e_ij(elec_num * (elec_num - 1) / 2, cord_num + 1))
|
|
|
|
! Prepare table of exponentiated distances raised to appropriate power
|
|
een_rescaled_e = 0.0d0
|
|
do nw = 1, walk_num
|
|
een_rescaled_e_ij = 0.0d0
|
|
een_rescaled_e_ij(:, 1) = 1.0d0
|
|
|
|
|
|
k = 0
|
|
do j = 1, elec_num
|
|
do i = 1, j - 1
|
|
k = k + 1
|
|
een_rescaled_e_ij(k, 2) = dexp(-rescale_factor_ee * ee_distance(i, j, nw))
|
|
end do
|
|
end do
|
|
|
|
|
|
do l = 2, cord_num
|
|
do k = 1, elec_num * (elec_num - 1)/2
|
|
een_rescaled_e_ij(k, l + 1) = een_rescaled_e_ij(k, l + 1 - 1) * een_rescaled_e_ij(k, 2)
|
|
end do
|
|
end do
|
|
|
|
! prepare the actual een table
|
|
een_rescaled_e(:, :, 0, nw) = 1.0d0
|
|
|
|
do l = 1, cord_num
|
|
k = 0
|
|
do j = 1, elec_num
|
|
do i = 1, j - 1
|
|
k = k + 1
|
|
x = een_rescaled_e_ij(k, l + 1)
|
|
een_rescaled_e(i, j, l, nw) = x
|
|
een_rescaled_e(j, i, l, nw) = x
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
do l = 0, cord_num
|
|
do j = 1, elec_num
|
|
een_rescaled_e(j, j, l, nw) = 0.0d0
|
|
end do
|
|
end do
|
|
|
|
end do
|
|
|
|
end function qmckl_compute_een_rescaled_e_doc_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_een_rescaled_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t cord_num,
|
|
const double rescale_factor_ee,
|
|
const double* ee_distance,
|
|
double* const een_rescaled_e );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname="qmckl_compute_een_rescaled_e_doc")
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_een_rescaled_e_doc &
|
|
(context, walk_num, elec_num, cord_num, rescale_factor_ee, &
|
|
ee_distance, een_rescaled_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
real (c_double ) , intent(in) , value :: rescale_factor_ee
|
|
real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num)
|
|
real (c_double ) , intent(out) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_een_rescaled_e_doc_f
|
|
info = qmckl_compute_een_rescaled_e_doc_f &
|
|
(context, walk_num, elec_num, cord_num, rescale_factor_ee, ee_distance, een_rescaled_e)
|
|
|
|
end function qmckl_compute_een_rescaled_e_doc
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_een_rescaled_e_hpc (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t cord_num,
|
|
const double rescale_factor_ee,
|
|
const double* ee_distance,
|
|
double* const een_rescaled_e ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
// Prepare table of exponentiated distances raised to appropriate power
|
|
// init
|
|
|
|
for (int kk = 0; kk < walk_num*(cord_num+1)*elec_num*elec_num; ++kk) {
|
|
een_rescaled_e[kk]= 0.0;
|
|
}
|
|
|
|
double x;
|
|
const int64_t elec_pairs = (elec_num * (elec_num - 1)) / 2;
|
|
const int64_t len_een_ij = elec_pairs * (cord_num + 1);
|
|
|
|
// number of elements for the een_rescaled_e_ij[N_e*(N_e-1)/2][cord+1]
|
|
// probably in C is better [cord+1, Ne*(Ne-1)/2]
|
|
// elec_pairs = (elec_num * (elec_num - 1)) / 2;
|
|
// len_een_ij = elec_pairs * (cord_num + 1);
|
|
double* een_rescaled_e_ij = (double *) malloc (len_een_ij * sizeof(double));
|
|
if (een_rescaled_e_ij == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_compute_een_rescaled_e_hpc",
|
|
NULL);
|
|
}
|
|
|
|
/*
|
|
for (int nw = 0; nw < walk_num; ++nw) {
|
|
for (int l = 0; l < (cord_num + 1); ++l) {
|
|
for (int i = 0; i < elec_num; ++i) {
|
|
for (int j = 0; j < elec_num; ++j) {
|
|
een_rescaled_e[j + i*elec_num + l*elec_num*elec_num + nw*(cord_num+1)*elec_num*elec_num]= 0.0;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
*/
|
|
|
|
for (int nw = 0; nw < walk_num; ++nw) {
|
|
|
|
for (int kk = 0; kk < len_een_ij; ++kk) {
|
|
// this array initialized at 0 except een_rescaled_e_ij(:, 1) = 1.0d0
|
|
// and the arrangement of indices is [cord_num+1, ne*(ne-1)/2]
|
|
een_rescaled_e_ij[kk]= ( kk < (elec_pairs) ? 1.0 : 0.0 );
|
|
}
|
|
|
|
int64_t kk = 0;
|
|
for (int i = 0; i < elec_num; ++i) {
|
|
for (int j = 0; j < i; ++j) {
|
|
// een_rescaled_e_ij(kk, 2) = dexp(-rescale_factor_ee * ee_distance(i, j, nw));
|
|
een_rescaled_e_ij[kk + elec_pairs] = exp(-rescale_factor_ee * \
|
|
ee_distance[j + i*elec_num + nw*(elec_num*elec_num)]);
|
|
kk += 1;
|
|
}
|
|
}
|
|
|
|
|
|
for (int l = 2; l < (cord_num+1); ++l) {
|
|
for (int k = 0; k < elec_pairs; ++k) {
|
|
// een_rescaled_e_ij(k, l + 1) = een_rescaled_e_ij(k, l + 1 - 1) * een_rescaled_e_ij(k, 2)
|
|
een_rescaled_e_ij[k+l*elec_pairs] = een_rescaled_e_ij[k + (l - 1)*elec_pairs] * \
|
|
een_rescaled_e_ij[k + elec_pairs];
|
|
}
|
|
}
|
|
|
|
|
|
// prepare the actual een table
|
|
for (int i = 0; i < elec_num; ++i){
|
|
for (int j = 0; j < elec_num; ++j) {
|
|
een_rescaled_e[j + i*elec_num + 0 + nw*(cord_num+1)*elec_num*elec_num] = 1.0;
|
|
}
|
|
}
|
|
|
|
// Up to here it should work.
|
|
for ( int l = 1; l < (cord_num+1); ++l) {
|
|
int k = 0;
|
|
for (int i = 0; i < elec_num; ++i) {
|
|
for (int j = 0; j < i; ++j) {
|
|
x = een_rescaled_e_ij[k + l*elec_pairs];
|
|
een_rescaled_e[j + i*elec_num + l*elec_num*elec_num + nw*elec_num*elec_num*(cord_num+1)] = x;
|
|
een_rescaled_e[i + j*elec_num + l*elec_num*elec_num + nw*elec_num*elec_num*(cord_num+1)] = x;
|
|
k = k + 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
for (int l = 0; l < (cord_num + 1); ++l) {
|
|
for (int j = 0; j < elec_num; ++j) {
|
|
een_rescaled_e[j + j*elec_num + l*elec_num*elec_num + nw*elec_num*elec_num*(cord_num+1)] = 0.0;
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
free(een_rescaled_e_ij);
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname="qmckl_compute_een_rescaled_e_doc")
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_een_rescaled_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t cord_num,
|
|
const double rescale_factor_ee,
|
|
const double* ee_distance,
|
|
double* const een_rescaled_e );
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_een_rescaled_e_doc (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t cord_num,
|
|
const double rescale_factor_ee,
|
|
const double* ee_distance,
|
|
double* const een_rescaled_e );
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_een_rescaled_e_hpc (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t cord_num,
|
|
const double rescale_factor_ee,
|
|
const double* ee_distance,
|
|
double* const een_rescaled_e );
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_een_rescaled_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t cord_num,
|
|
const double rescale_factor_ee,
|
|
const double* ee_distance,
|
|
double* const een_rescaled_e ) {
|
|
|
|
#ifdef HAVE_HPC
|
|
return qmckl_compute_een_rescaled_e_hpc(context, walk_num, elec_num, cord_num, rescale_factor_ee, ee_distance, een_rescaled_e);
|
|
#else
|
|
return qmckl_compute_een_rescaled_e_doc(context, walk_num, elec_num, cord_num, rescale_factor_ee, ee_distance, een_rescaled_e);
|
|
#endif
|
|
}
|
|
#+end_src
|
|
|
|
|
|
*** Test
|
|
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
elec_coord = np.array(elec_coord)[0]
|
|
elec_dist = np.zeros(shape=(elec_num, elec_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for j in range(elec_num):
|
|
elec_dist[i, j] = np.linalg.norm(elec_coord[i] - elec_coord[j])
|
|
|
|
kappa = 1.0
|
|
|
|
een_rescaled_e_ij = np.zeros(shape=(elec_num * (elec_num - 1)//2, cord_num+1), dtype=float)
|
|
een_rescaled_e_ij[:,0] = 1.0
|
|
|
|
k = 0
|
|
for j in range(elec_num):
|
|
for i in range(j):
|
|
een_rescaled_e_ij[k, 1] = np.exp(-kappa * elec_dist[i, j])
|
|
k = k + 1
|
|
|
|
for l in range(2, cord_num + 1):
|
|
for k in range(elec_num * (elec_num - 1)//2):
|
|
een_rescaled_e_ij[k, l] = een_rescaled_e_ij[k, l - 1] * een_rescaled_e_ij[k, 1]
|
|
|
|
een_rescaled_e = np.zeros(shape=(elec_num, elec_num, cord_num + 1), dtype=float)
|
|
een_rescaled_e[:,:,0] = 1.0
|
|
|
|
for l in range(1,cord_num+1):
|
|
k = 0
|
|
for j in range(elec_num):
|
|
for i in range(j):
|
|
x = een_rescaled_e_ij[k, l]
|
|
een_rescaled_e[i, j, l] = x
|
|
een_rescaled_e[j, i, l] = x
|
|
k = k + 1
|
|
|
|
for l in range(0,cord_num+1):
|
|
for j in range(0, elec_num):
|
|
een_rescaled_e[j,j,l] = 0.0
|
|
|
|
print(" een_rescaled_e[0, 2, 1] = ",een_rescaled_e[0, 2, 1])
|
|
print(" een_rescaled_e[0, 3, 1] = ",een_rescaled_e[0, 3, 1])
|
|
print(" een_rescaled_e[0, 4, 1] = ",een_rescaled_e[0, 4, 1])
|
|
print(" een_rescaled_e[1, 3, 2] = ",een_rescaled_e[1, 3, 2])
|
|
print(" een_rescaled_e[1, 4, 2] = ",een_rescaled_e[1, 4, 2])
|
|
print(" een_rescaled_e[1, 5, 2] = ",een_rescaled_e[1, 5, 2])
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: een_rescaled_e[0, 2, 1] = 0.08084493981483197
|
|
: een_rescaled_e[0, 3, 1] = 0.1066745707571846
|
|
: een_rescaled_e[0, 4, 1] = 0.017542731694647366
|
|
: een_rescaled_e[1, 3, 2] = 0.02214680362033448
|
|
: een_rescaled_e[1, 4, 2] = 0.0005700154999202759
|
|
: een_rescaled_e[1, 5, 2] = 0.3424402276009091
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
|
|
double een_rescaled_e[walk_num][(cord_num + 1)][elec_num][elec_num];
|
|
rc = qmckl_get_jastrow_een_rescaled_e(context, &(een_rescaled_e[0][0][0][0]),elec_num*elec_num*(cord_num+1)*walk_num);
|
|
|
|
// value of (0,2,1)
|
|
assert(fabs(een_rescaled_e[0][1][0][2]-0.08084493981483197) < 1.e-12);
|
|
assert(fabs(een_rescaled_e[0][1][0][3]-0.1066745707571846) < 1.e-12);
|
|
assert(fabs(een_rescaled_e[0][1][0][4]-0.01754273169464735) < 1.e-12);
|
|
assert(fabs(een_rescaled_e[0][2][1][3]-0.02214680362033448) < 1.e-12);
|
|
assert(fabs(een_rescaled_e[0][2][1][4]-0.0005700154999202759) < 1.e-12);
|
|
assert(fabs(een_rescaled_e[0][2][1][5]-0.3424402276009091) < 1.e-12);
|
|
#+end_src
|
|
|
|
** Electron-electron-nucleus rescaled distances for each order and derivatives ~een_rescaled_e_deriv_e~ stores the table of the derivatives of the
|
|
rescaled distances between all pairs of electrons and raised to the
|
|
power \(p\) defined by ~cord_num~. Here we take its derivatives
|
|
required for the een jastrow.
|
|
|
|
TODO: write formulae
|
|
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_e_deriv_e(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_een_rescaled_e_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * 4 * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1);
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_een_deriv_e",
|
|
"Array too small. Expected ctx->electron.num * 4 * ctx->electron.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1)");
|
|
}
|
|
memcpy(distance_rescaled, ctx->jastrow.een_rescaled_e_deriv_e, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_e_deriv_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_e_deriv_e(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if ee distance is provided */
|
|
qmckl_exit_code rc = qmckl_provide_een_rescaled_e(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.een_rescaled_e_deriv_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.een_rescaled_e_deriv_e != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.een_rescaled_e_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_een_rescaled_e_deriv_e",
|
|
"Unable to free ctx->jastrow.een_rescaled_e_deriv_e");
|
|
}
|
|
ctx->jastrow.een_rescaled_e_deriv_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.een_rescaled_e_deriv_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.num * 4 * ctx->electron.num *
|
|
ctx->electron.walker.num * (ctx->jastrow.cord_num + 1) * sizeof(double);
|
|
double* een_rescaled_e_deriv_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (een_rescaled_e_deriv_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_een_rescaled_e_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_e_deriv_e = een_rescaled_e_deriv_e;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_een_rescaled_e_deriv_e(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.rescale_factor_ee,
|
|
ctx->electron.walker.point.coord.data,
|
|
ctx->electron.ee_distance,
|
|
ctx->jastrow.een_rescaled_e,
|
|
ctx->jastrow.een_rescaled_e_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.een_rescaled_e_deriv_e_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_een_rescaled_e_deriv_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_een_rescaled_e_deriv_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------+-------------------------------------------------------+--------+--------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~rescale_factor_ee~ | ~double~ | in | Factor to rescale ee distances |
|
|
| ~coord_ee~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates |
|
|
| ~ee_distance~ | ~double[walk_num][elec_num][elec_num]~ | in | Electron-electron distances |
|
|
| ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron distances |
|
|
| ~een_rescaled_e_deriv_e~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | out | Electron-electron rescaled distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_een_rescaled_e_deriv_e_f( &
|
|
context, walk_num, elec_num, cord_num, rescale_factor_ee, &
|
|
coord_ee, ee_distance, een_rescaled_e, een_rescaled_e_deriv_e) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: cord_num
|
|
double precision , intent(in) :: rescale_factor_ee
|
|
double precision , intent(in) :: coord_ee(elec_num,3,walk_num)
|
|
double precision , intent(in) :: ee_distance(elec_num,elec_num,walk_num)
|
|
double precision , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
|
|
double precision , intent(out) :: een_rescaled_e_deriv_e(elec_num,4,elec_num,0:cord_num,walk_num)
|
|
double precision,dimension(:,:,:),allocatable :: elec_dist_deriv_e
|
|
double precision :: x, rij_inv, kappa_l
|
|
integer*8 :: i, j, k, l, nw, ii
|
|
|
|
allocate(elec_dist_deriv_e(4,elec_num,elec_num))
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
! Prepare table of exponentiated distances raised to appropriate power
|
|
een_rescaled_e_deriv_e = 0.0d0
|
|
do nw = 1, walk_num
|
|
do j = 1, elec_num
|
|
do i = 1, elec_num
|
|
rij_inv = 1.0d0 / ee_distance(i, j, nw)
|
|
do ii = 1, 3
|
|
elec_dist_deriv_e(ii, i, j) = (coord_ee(i, ii, nw) - coord_ee(j, ii, nw)) * rij_inv
|
|
end do
|
|
elec_dist_deriv_e(4, i, j) = 2.0d0 * rij_inv
|
|
end do
|
|
elec_dist_deriv_e(:, j, j) = 0.0d0
|
|
end do
|
|
|
|
! prepare the actual een table
|
|
do l = 1, cord_num
|
|
kappa_l = - dble(l) * rescale_factor_ee
|
|
do j = 1, elec_num
|
|
do i = 1, elec_num
|
|
een_rescaled_e_deriv_e(i, 1, j, l, nw) = kappa_l * elec_dist_deriv_e(1, i, j)
|
|
een_rescaled_e_deriv_e(i, 2, j, l, nw) = kappa_l * elec_dist_deriv_e(2, i, j)
|
|
een_rescaled_e_deriv_e(i, 3, j, l, nw) = kappa_l * elec_dist_deriv_e(3, i, j)
|
|
een_rescaled_e_deriv_e(i, 4, j, l, nw) = kappa_l * elec_dist_deriv_e(4, i, j)
|
|
|
|
een_rescaled_e_deriv_e(i, 4, j, l, nw) = een_rescaled_e_deriv_e(i, 4, j, l, nw) &
|
|
+ een_rescaled_e_deriv_e(i, 1, j, l, nw) * een_rescaled_e_deriv_e(i, 1, j, l, nw) &
|
|
+ een_rescaled_e_deriv_e(i, 2, j, l, nw) * een_rescaled_e_deriv_e(i, 2, j, l, nw) &
|
|
+ een_rescaled_e_deriv_e(i, 3, j, l, nw) * een_rescaled_e_deriv_e(i, 3, j, l, nw)
|
|
|
|
een_rescaled_e_deriv_e(i, 1, j, l, nw) = een_rescaled_e_deriv_e(i, 1, j, l, nw) * &
|
|
een_rescaled_e(i, j, l, nw)
|
|
een_rescaled_e_deriv_e(i, 3, j, l, nw) = een_rescaled_e_deriv_e(i, 2, j, l, nw) * &
|
|
een_rescaled_e(i, j, l, nw)
|
|
een_rescaled_e_deriv_e(i, 3, j, l, nw) = een_rescaled_e_deriv_e(i, 3, j, l, nw) * &
|
|
een_rescaled_e(i, j, l, nw)
|
|
een_rescaled_e_deriv_e(i, 4, j, l, nw) = een_rescaled_e_deriv_e(i, 4, j, l, nw) * &
|
|
een_rescaled_e(i, j, l, nw)
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_een_rescaled_e_deriv_e_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_een_rescaled_e_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t cord_num,
|
|
const double rescale_factor_ee,
|
|
const double* coord_ee,
|
|
const double* ee_distance,
|
|
const double* een_rescaled_e,
|
|
double* const een_rescaled_e_deriv_e );
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_e_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_een_rescaled_e_deriv_e &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
cord_num, &
|
|
rescale_factor_ee, &
|
|
coord_ee, &
|
|
ee_distance, &
|
|
een_rescaled_e, &
|
|
een_rescaled_e_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
real (c_double ) , intent(in) , value :: rescale_factor_ee
|
|
real (c_double ) , intent(in) :: coord_ee(elec_num,3,walk_num)
|
|
real (c_double ) , intent(in) :: ee_distance(elec_num,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(out) :: een_rescaled_e_deriv_e(elec_num,4,elec_num,0:cord_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_een_rescaled_e_deriv_e_f
|
|
info = qmckl_compute_factor_een_rescaled_e_deriv_e_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
cord_num, &
|
|
rescale_factor_ee, &
|
|
coord_ee, &
|
|
ee_distance, &
|
|
een_rescaled_e, &
|
|
een_rescaled_e_deriv_e)
|
|
|
|
end function qmckl_compute_factor_een_rescaled_e_deriv_e
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+name: een_e_deriv_e
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
elec_coord = np.array(elec_coord)[0]
|
|
elec_dist = np.zeros(shape=(elec_num, elec_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for j in range(elec_num):
|
|
elec_dist[i, j] = np.linalg.norm(elec_coord[i] - elec_coord[j])
|
|
|
|
elec_dist_deriv_e = np.zeros(shape=(4,elec_num, elec_num),dtype=float)
|
|
for j in range(elec_num):
|
|
for i in range(elec_num):
|
|
rij_inv = 1.0 / elec_dist[i, j]
|
|
for ii in range(3):
|
|
elec_dist_deriv_e[ii, i, j] = -(elec_coord[j][ii] - elec_coord[i][ii]) * rij_inv
|
|
elec_dist_deriv_e[3, i, j] = 2.0 * rij_inv
|
|
elec_dist_deriv_e[:, j, j] = 0.0
|
|
|
|
|
|
kappa = 1.0
|
|
|
|
een_rescaled_e_ij = np.zeros(shape=(elec_num * (elec_num - 1)//2, cord_num+1), dtype=float)
|
|
een_rescaled_e_ij[:,0] = 1.0
|
|
|
|
k = 0
|
|
for j in range(elec_num):
|
|
for i in range(j):
|
|
een_rescaled_e_ij[k, 1] = np.exp(-kappa * elec_dist[i, j])
|
|
k = k + 1
|
|
|
|
for l in range(2, cord_num + 1):
|
|
for k in range(elec_num * (elec_num - 1)//2):
|
|
een_rescaled_e_ij[k, l] = een_rescaled_e_ij[k, l - 1] * een_rescaled_e_ij[k, 1]
|
|
|
|
een_rescaled_e = np.zeros(shape=(elec_num, elec_num, cord_num + 1), dtype=float)
|
|
een_rescaled_e[:,:,0] = 1.0
|
|
|
|
for l in range(1,cord_num+1):
|
|
k = 0
|
|
for j in range(elec_num):
|
|
for i in range(j):
|
|
x = een_rescaled_e_ij[k, l]
|
|
een_rescaled_e[i, j, l] = x
|
|
een_rescaled_e[j, i, l] = x
|
|
k = k + 1
|
|
|
|
een_rescaled_e_deriv_e = np.zeros(shape=(elec_num,4,elec_num,cord_num+1),dtype=float)
|
|
for l in range(0,cord_num+1):
|
|
kappa_l = -1.0 * kappa * l
|
|
for j in range(0,elec_num):
|
|
for i in range(0,elec_num):
|
|
for ii in range(0,4):
|
|
een_rescaled_e_deriv_e[i,ii,j,l] = kappa_l * elec_dist_deriv_e[ii,i,j]
|
|
een_rescaled_e_deriv_e[i,3,j,l] = een_rescaled_e_deriv_e[i,3,j,l] + \
|
|
een_rescaled_e_deriv_e[i,0,j,l] * een_rescaled_e_deriv_e[i,0,j,l] + \
|
|
een_rescaled_e_deriv_e[i,1,j,l] * een_rescaled_e_deriv_e[i,1,j,l] + \
|
|
een_rescaled_e_deriv_e[i,2,j,l] * een_rescaled_e_deriv_e[i,2,j,l]
|
|
|
|
for ii in range(0,4):
|
|
een_rescaled_e_deriv_e[i,ii,j,l] = een_rescaled_e_deriv_e[i,ii,j,l] * een_rescaled_e[i,j,l]
|
|
|
|
#print(" een_rescaled_e_deriv_e[1, 1, 3, 1] = ",een_rescaled_e_deriv_e[0, 0, 2, 1])
|
|
#print(" een_rescaled_e_deriv_e[1, 1, 4, 1] = ",een_rescaled_e_deriv_e[0, 0, 3, 1])
|
|
#print(" een_rescaled_e_deriv_e[1, 1, 5, 1] = ",een_rescaled_e_deriv_e[0, 0, 4, 1])
|
|
#print(" een_rescaled_e_deriv_e[2, 1, 4, 2] = ",een_rescaled_e_deriv_e[1, 0, 3, 2])
|
|
#print(" een_rescaled_e_deriv_e[2, 1, 5, 2] = ",een_rescaled_e_deriv_e[1, 0, 4, 2])
|
|
#print(" een_rescaled_e_deriv_e[2, 1, 6, 2] = ",een_rescaled_e_deriv_e[1, 0, 5, 2])
|
|
#+end_src
|
|
|
|
#+RESULTS: een_e_deriv_e
|
|
: een_rescaled_e_deriv_e[1, 1, 3, 1] = 0.05991352796887283
|
|
: een_rescaled_e_deriv_e[1, 1, 4, 1] = 0.011714035071545248
|
|
: een_rescaled_e_deriv_e[1, 1, 5, 1] = 0.00441398875758468
|
|
: een_rescaled_e_deriv_e[2, 1, 4, 2] = 0.013553180060167595
|
|
: een_rescaled_e_deriv_e[2, 1, 5, 2] = 0.00041342909359870457
|
|
: een_rescaled_e_deriv_e[2, 1, 6, 2] = 0.5880599146214673
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
double een_rescaled_e_deriv_e[walk_num][(cord_num + 1)][elec_num][4][elec_num];
|
|
size_max=walk_num*(cord_num + 1)*elec_num*4*elec_num;
|
|
rc = qmckl_get_jastrow_een_rescaled_e_deriv_e(context,
|
|
&(een_rescaled_e_deriv_e[0][0][0][0][0]),size_max);
|
|
|
|
// value of (0,0,0,2,1)
|
|
assert(fabs(een_rescaled_e_deriv_e[0][1][0][0][2] + 0.05991352796887283 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_e_deriv_e[0][1][0][0][3] + 0.011714035071545248 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_e_deriv_e[0][1][0][0][4] + 0.00441398875758468 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][3] + 0.013553180060167595 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][4] + 0.00041342909359870457) < 1.e-12);
|
|
assert(fabs(een_rescaled_e_deriv_e[0][2][1][0][5] + 0.5880599146214673 ) < 1.e-12);
|
|
#+end_src
|
|
|
|
** Electron-nucleus rescaled distances ~en_distance_rescaled~ stores the matrix of the rescaled distances between
|
|
electrons and nuclei.
|
|
|
|
\[
|
|
C_{ij} = \left( 1 - \exp{-\kappa C_{ij}}\right)/\kappa
|
|
\]
|
|
|
|
where \(C_{ij}\) is the matrix of electron-nucleus distances.
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code qmckl_get_electron_en_distance_rescaled(qmckl_context context, double* distance_rescaled);
|
|
#+end_src
|
|
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_get_electron_en_distance_rescaled(qmckl_context context, double* distance_rescaled)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_en_distance_rescaled(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num;
|
|
memcpy(distance_rescaled, ctx->jastrow.en_distance_rescaled, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_en_distance_rescaled(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_en_distance_rescaled(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!(ctx->nucleus.provided)) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->electron.walker.point.date > ctx->jastrow.en_distance_rescaled_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.en_distance_rescaled != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.en_distance_rescaled);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_en_distance_rescaled",
|
|
"Unable to free ctx->jastrow.en_distance_rescaled");
|
|
}
|
|
ctx->jastrow.en_distance_rescaled = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.en_distance_rescaled == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.num * ctx->nucleus.num *
|
|
ctx->electron.walker.num * sizeof(double);
|
|
double* en_distance_rescaled = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (en_distance_rescaled == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_en_distance_rescaled",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.en_distance_rescaled = en_distance_rescaled;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_en_distance_rescaled(context,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.rescale_factor_en,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.walker.point.coord.data,
|
|
ctx->nucleus.coord.data,
|
|
ctx->jastrow.en_distance_rescaled);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.en_distance_rescaled_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_en_distance_rescaled
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_en_distance_rescaled_args
|
|
| Variable | Type | In/Out | Description |
|
|
|------------------------+----------------------------------------+--------+-----------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of types of nuclei |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | Number of types of nuclei |
|
|
| ~rescale_factor_en~ | ~double[type_nucl_num]~ | in | The factor for rescaled distances |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates |
|
|
| ~nucl_coord~ | ~double[3][elec_num]~ | in | Nuclear coordinates |
|
|
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | out | Electron-nucleus distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_en_distance_rescaled_f(context, elec_num, nucl_num, type_nucl_num, &
|
|
type_nucl_vector, rescale_factor_en, walk_num, elec_coord, &
|
|
nucl_coord, en_distance_rescaled) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
double precision , intent(in) :: rescale_factor_en(type_nucl_num)
|
|
integer*8 , intent(in) :: walk_num
|
|
double precision , intent(in) :: elec_coord(elec_num,walk_num,3)
|
|
double precision , intent(in) :: nucl_coord(nucl_num,3)
|
|
double precision , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
|
|
|
|
integer*8 :: i, k
|
|
double precision :: coord(3)
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
do i=1, nucl_num
|
|
coord(1:3) = nucl_coord(i,1:3)
|
|
do k=1,walk_num
|
|
info = qmckl_distance_rescaled(context, 'T', 'T', elec_num, 1_8, &
|
|
elec_coord(1,k,1), elec_num*walk_num, coord, 1_8, &
|
|
en_distance_rescaled(1,i,k), elec_num, rescale_factor_en(type_nucl_vector(i)))
|
|
if (info /= QMCKL_SUCCESS) then
|
|
return
|
|
endif
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_en_distance_rescaled_f
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
|
|
qmckl_exit_code qmckl_compute_en_distance_rescaled (
|
|
const qmckl_context context,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
int64_t* const type_nucl_vector,
|
|
const double* rescale_factor_en,
|
|
const int64_t walk_num,
|
|
const double* elec_coord,
|
|
const double* nucl_coord,
|
|
double* const en_distance_rescaled );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_en_distance_rescaled_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_en_distance_rescaled &
|
|
(context, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
rescale_factor_en, &
|
|
walk_num, &
|
|
elec_coord, &
|
|
nucl_coord, &
|
|
en_distance_rescaled) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num)
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
|
|
real (c_double ) , intent(in) :: nucl_coord(elec_num,3)
|
|
real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_en_distance_rescaled_f
|
|
info = qmckl_compute_en_distance_rescaled_f &
|
|
(context, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
rescale_factor_en, &
|
|
walk_num, &
|
|
elec_coord, &
|
|
nucl_coord, &
|
|
en_distance_rescaled)
|
|
|
|
end function qmckl_compute_en_distance_rescaled
|
|
#+end_src
|
|
|
|
*** Test
|
|
|
|
#+begin_src python :results output :exports none
|
|
import numpy as np
|
|
|
|
kappa = 1.0
|
|
|
|
elec_1_w1 = np.array( [-0.250655104764153, 0.503070975550133 , -0.166554344502303])
|
|
elec_2_w1 = np.array( [-0.587812193472177, -0.128751981129274 , 0.187773606533075])
|
|
elec_5_w1 = np.array( [-0.127732483187947, -0.138975497694196 , -8.669850480215846E-002])
|
|
elec_6_w1 = np.array( [-0.232271834949124, -1.059321673434182E-002 , -0.504862241464867])
|
|
nucl_1 = np.array( [ 0., 0., 0. ])
|
|
nucl_2 = np.array( [ 0., 0., 2.059801 ])
|
|
|
|
print ( "[0][0] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_1_w1-nucl_1)) )/kappa )
|
|
print ( "[1][0] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_1_w1-nucl_2)) )/kappa )
|
|
print ( "[0][1] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_2_w1-nucl_1)) )/kappa )
|
|
print ( "[0][5] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_5_w1-nucl_1)) )/kappa )
|
|
print ( "[1][5] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_5_w1-nucl_2)) )/kappa )
|
|
print ( "[0][6] : ", (1.0 - np.exp(-kappa * np.linalg.norm(elec_6_w1-nucl_1)) )/kappa )
|
|
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: [0][0] : 0.4435709484118112
|
|
: [1][0] : 0.8993601506374442
|
|
: [0][1] : 0.46760219699910477
|
|
: [0][5] : 0.1875631834682101
|
|
: [1][5] : 0.8840716589810682
|
|
: [0][6] : 0.42640469987268914
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
|
|
assert(qmckl_electron_provided(context));
|
|
assert(qmckl_nucleus_provided(context));
|
|
|
|
double en_distance_rescaled[walk_num][nucl_num][elec_num];
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_electron_en_distance_rescaled(context, &(en_distance_rescaled[0][0][0]))
|
|
);
|
|
assert (rc == QMCKL_SUCCESS);
|
|
|
|
// (e,n,w) in Fortran notation
|
|
// (1,1,1)
|
|
assert(fabs(en_distance_rescaled[0][0][0] - 0.4435709484118112) < 1.e-12);
|
|
|
|
// (1,2,1)
|
|
assert(fabs(en_distance_rescaled[0][1][0] - 0.8993601506374442) < 1.e-12);
|
|
|
|
// (2,1,1)
|
|
assert(fabs(en_distance_rescaled[0][0][1] - 0.46760219699910477) < 1.e-12);
|
|
|
|
// (1,1,2)
|
|
assert(fabs(en_distance_rescaled[0][0][5] - 0.1875631834682101) < 1.e-12);
|
|
|
|
// (1,2,2)
|
|
assert(fabs(en_distance_rescaled[0][1][5] - 0.8840716589810682) < 1.e-12);
|
|
|
|
// (2,1,2)
|
|
assert(fabs(en_distance_rescaled[0][0][6] - 0.42640469987268914) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-electron-nucleus rescaled distance gradients and laplacian with respect to electron coords
|
|
|
|
The rescaled distances which is given as $R = (1 - \exp{-\kappa r})/\kappa$
|
|
needs to be perturbed with respect to the nuclear coordinates.
|
|
This data is stored in the ~en_distance_rescaled_deriv_e~ tensor. The
|
|
The first three elements of this three index tensor ~[4][nucl_num][elec_num]~ gives the
|
|
derivatives in the x, y, and z directions $dx, dy, dz$ and the last index
|
|
gives the Laplacian $\partial x^2 + \partial y^2 + \partial z^2$.
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code qmckl_get_electron_en_distance_rescaled_deriv_e(qmckl_context context, double* distance_rescaled_deriv_e);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_get_electron_en_distance_rescaled_deriv_e(qmckl_context context, double* distance_rescaled_deriv_e)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_en_distance_rescaled_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = 4 * ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num;
|
|
memcpy(distance_rescaled_deriv_e, ctx->jastrow.en_distance_rescaled_deriv_e, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_en_distance_rescaled_deriv_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_en_distance_rescaled_deriv_e(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
if (!(ctx->nucleus.provided)) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->electron.walker.point.date > ctx->jastrow.en_distance_rescaled_deriv_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.en_distance_rescaled_deriv_e != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.en_distance_rescaled_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_en_distance_rescaled_deriv_e",
|
|
"Unable to free ctx->jastrow.en_distance_rescaled_deriv_e");
|
|
}
|
|
ctx->jastrow.en_distance_rescaled_deriv_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.en_distance_rescaled_deriv_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = 4 * ctx->electron.num * ctx->nucleus.num *
|
|
ctx->electron.walker.num * sizeof(double);
|
|
double* en_distance_rescaled_deriv_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (en_distance_rescaled_deriv_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_en_distance_rescaled_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.en_distance_rescaled_deriv_e = en_distance_rescaled_deriv_e;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_en_distance_rescaled_deriv_e(context,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.rescale_factor_en,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.walker.point.coord.data,
|
|
ctx->nucleus.coord.data,
|
|
ctx->jastrow.en_distance_rescaled_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.en_distance_rescaled_deriv_e_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_en_distance_rescaled_deriv_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_en_distance_rescaled_deriv_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------------+-------------------------------------------+--------+---------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nuclei |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of nucleus types |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | Array of nucleus types |
|
|
| ~rescale_factor_en~ | ~double[nucl_num]~ | in | The factors for rescaled distances |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_coord~ | ~double[3][walk_num][elec_num]~ | in | Electron coordinates |
|
|
| ~nucl_coord~ | ~double[3][elec_num]~ | in | Nuclear coordinates |
|
|
| ~en_distance_rescaled_deriv_e~ | ~double[walk_num][nucl_num][elec_num][4]~ | out | Electron-nucleus distance derivatives |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_en_distance_rescaled_deriv_e_f(context, elec_num, nucl_num, &
|
|
type_nucl_num, type_nucl_vector, rescale_factor_en, walk_num, elec_coord, &
|
|
nucl_coord, en_distance_rescaled_deriv_e) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
double precision , intent(in) :: rescale_factor_en(nucl_num)
|
|
integer*8 , intent(in) :: walk_num
|
|
double precision , intent(in) :: elec_coord(elec_num,walk_num,3)
|
|
double precision , intent(in) :: nucl_coord(nucl_num,3)
|
|
double precision , intent(out) :: en_distance_rescaled_deriv_e(4,elec_num,nucl_num,walk_num)
|
|
|
|
integer*8 :: i, k
|
|
double precision :: coord(3)
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
do i=1, nucl_num
|
|
coord(1:3) = nucl_coord(i,1:3)
|
|
do k=1,walk_num
|
|
info = qmckl_distance_rescaled_deriv_e(context, 'T', 'T', elec_num, 1_8, &
|
|
elec_coord(1,k,1), elec_num*walk_num, coord, 1_8, &
|
|
en_distance_rescaled_deriv_e(1,1,i,k), elec_num, rescale_factor_en(type_nucl_vector(i)))
|
|
if (info /= QMCKL_SUCCESS) then
|
|
return
|
|
endif
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_en_distance_rescaled_deriv_e_f
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
|
|
qmckl_exit_code qmckl_compute_en_distance_rescaled_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
int64_t* const type_nucl_vector,
|
|
const double* rescale_factor_en,
|
|
const int64_t walk_num,
|
|
const double* elec_coord,
|
|
const double* nucl_coord,
|
|
double* const en_distance_rescaled_deriv_e );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_en_distance_rescaled_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_en_distance_rescaled_deriv_e &
|
|
(context, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
rescale_factor_en, &
|
|
walk_num, &
|
|
elec_coord, &
|
|
nucl_coord, &
|
|
en_distance_rescaled_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
real (c_double ) , intent(in) :: rescale_factor_en(nucl_num)
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
|
|
real (c_double ) , intent(in) :: nucl_coord(elec_num,3)
|
|
real (c_double ) , intent(out) :: en_distance_rescaled_deriv_e(4,elec_num,nucl_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_en_distance_rescaled_deriv_e_f
|
|
info = qmckl_compute_en_distance_rescaled_deriv_e_f &
|
|
(context, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
rescale_factor_en, &
|
|
walk_num, &
|
|
elec_coord, &
|
|
nucl_coord, &
|
|
en_distance_rescaled_deriv_e)
|
|
|
|
end function qmckl_compute_en_distance_rescaled_deriv_e
|
|
#+end_src
|
|
|
|
*** Test
|
|
|
|
#+begin_src python :results output :exports none
|
|
import numpy as np
|
|
|
|
# TODO
|
|
#+end_src
|
|
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
assert(qmckl_nucleus_provided(context));
|
|
|
|
double en_distance_rescaled_deriv_e[walk_num][4][nucl_num][elec_num];
|
|
|
|
rc = qmckl_check(context,
|
|
qmckl_get_electron_en_distance_rescaled_deriv_e(context, &(en_distance_rescaled_deriv_e[0][0][0][0]))
|
|
);
|
|
assert (rc == QMCKL_SUCCESS);
|
|
|
|
// TODO: check exact values
|
|
//// (e,n,w) in Fortran notation
|
|
//// (1,1,1)
|
|
//assert(fabs(en_distance_rescaled[0][0][0] - 7.546738741619978) < 1.e-12);
|
|
//
|
|
//// (1,2,1)
|
|
//assert(fabs(en_distance_rescaled[0][1][0] - 8.77102435246984) < 1.e-12);
|
|
//
|
|
//// (2,1,1)
|
|
//assert(fabs(en_distance_rescaled[0][0][1] - 3.698922010513608) < 1.e-12);
|
|
//
|
|
//// (1,1,2)
|
|
//assert(fabs(en_distance_rescaled[1][0][0] - 5.824059436060509) < 1.e-12);
|
|
//
|
|
//// (1,2,2)
|
|
//assert(fabs(en_distance_rescaled[1][1][0] - 7.080482110317645) < 1.e-12);
|
|
//
|
|
//// (2,1,2)
|
|
//assert(fabs(en_distance_rescaled[1][0][1] - 3.1804527583077356) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Electron-electron-nucleus rescaled distances for each order ~een_rescaled_n~ stores the table of the rescaled distances between
|
|
electrons and nucleii raised to the power \(p\) defined by ~cord_num~:
|
|
|
|
\[
|
|
C_{ia,p} = \left( 1 - \exp{-\kappa C_{ia}} \right)^p
|
|
\]
|
|
|
|
where \(C_{ia}\) is the matrix of electron-nucleus distances.
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_n(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_n(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_een_rescaled_n(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1);
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_een_deriv_e",
|
|
"Array too small. Expected ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1)");
|
|
}
|
|
memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_n(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_n(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if ee distance is provided */
|
|
qmckl_exit_code rc = qmckl_provide_en_distance(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.een_rescaled_n_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.een_rescaled_n != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.een_rescaled_n);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_een_rescaled_n",
|
|
"Unable to free ctx->jastrow.een_rescaled_n");
|
|
}
|
|
ctx->jastrow.een_rescaled_n = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.een_rescaled_n == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.num * ctx->nucleus.num *
|
|
ctx->electron.walker.num * (ctx->jastrow.cord_num + 1) * sizeof(double);
|
|
double* een_rescaled_n = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (een_rescaled_n == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_een_rescaled_n",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_n = een_rescaled_n;
|
|
}
|
|
|
|
rc = qmckl_compute_een_rescaled_n(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.rescale_factor_en,
|
|
ctx->electron.en_distance,
|
|
ctx->jastrow.een_rescaled_n);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.een_rescaled_n_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_een_rescaled_n
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_een_rescaled_n_args
|
|
| Variable | Type | In/Out | Description |
|
|
|---------------------+----------------------------------------------------+--------+-------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of atoms |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of atom types |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | Types of atoms |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~rescale_factor_en~ | ~double[nucl_num]~ | in | Factor to rescale ee distances |
|
|
| ~en_distance~ | ~double[walk_num][elec_num][nucl_num]~ | in | Electron-nucleus distances |
|
|
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | out | Electron-nucleus rescaled distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_een_rescaled_n_f( &
|
|
context, walk_num, elec_num, nucl_num, &
|
|
type_nucl_num, type_nucl_vector, cord_num, rescale_factor_en, &
|
|
en_distance, een_rescaled_n) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
integer*8 , intent(in) :: cord_num
|
|
double precision , intent(in) :: rescale_factor_en(type_nucl_num)
|
|
double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num)
|
|
double precision , intent(out) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
double precision :: x
|
|
integer*8 :: i, a, k, l, nw
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
! Prepare table of exponentiated distances raised to appropriate power
|
|
een_rescaled_n = 0.0d0
|
|
do nw = 1, walk_num
|
|
|
|
! prepare the actual een table
|
|
een_rescaled_n(:, :, 0, nw) = 1.0d0
|
|
|
|
do a = 1, nucl_num
|
|
do i = 1, elec_num
|
|
een_rescaled_n(i, a, 1, nw) = dexp(-rescale_factor_en(type_nucl_vector(a)) * en_distance(i, a, nw))
|
|
end do
|
|
end do
|
|
|
|
do l = 2, cord_num
|
|
do a = 1, nucl_num
|
|
do i = 1, elec_num
|
|
een_rescaled_n(i, a, l, nw) = een_rescaled_n(i, a, l - 1, nw) * een_rescaled_n(i, a, 1, nw)
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end do
|
|
|
|
end function qmckl_compute_een_rescaled_n_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
/*
|
|
qmckl_exit_code qmckl_compute_een_rescaled_n (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
int64_t* const type_nucl_vector,
|
|
const int64_t cord_num,
|
|
const double* rescale_factor_en,
|
|
const double* en_distance,
|
|
double* const een_rescaled_n ) {
|
|
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_5;
|
|
}
|
|
|
|
// Prepare table of exponentiated distances raised to appropriate power
|
|
for (int i = 0; i < (walk_num*(cord_num+1)*nucl_num*elec_num); ++i) {
|
|
een_rescaled_n[i] = 1.0;
|
|
}
|
|
|
|
for (int nw = 0; nw < walk_num; ++nw) {
|
|
for (int a = 0; a < nucl_num; ++a) {
|
|
for (int i = 0; i < elec_num; ++i) {
|
|
een_rescaled_n[i + a*elec_num + nw * elec_num*nucl_num*(cord_num+1)] = 1.0;
|
|
een_rescaled_n[i + a*elec_num + elec_num*nucl_num + nw*elec_num*nucl_num*(cord_num+1)] =
|
|
exp(-rescale_factor_en[type_nucl_vector[a]] * en_distance[i + a*elec_num + nw*elec_num*nucl_num]);
|
|
}
|
|
}
|
|
|
|
for (int l = 2; l < (cord_num+1); ++l){
|
|
for (int a = 0; a < nucl_num; ++a) {
|
|
for (int i = 0; i < elec_num; ++i) {
|
|
een_rescaled_n[i + a*elec_num + l*elec_num*nucl_num + nw*elec_num*nucl_num*(cord_num+1)] =
|
|
een_rescaled_n[i + a*elec_num + (l-1)*elec_num*nucl_num + nw*elec_num*nucl_num*(cord_num+1)] *
|
|
een_rescaled_n[i + a*elec_num + elec_num*nucl_num + nw*elec_num*nucl_num*(cord_num+1)];
|
|
}
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
*/
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_n_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_een_rescaled_n &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
cord_num, &
|
|
rescale_factor_en, &
|
|
en_distance, &
|
|
een_rescaled_n) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
real (c_double ) , intent(in) :: rescale_factor_en(nucl_num)
|
|
real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num)
|
|
real (c_double ) , intent(out) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_een_rescaled_n_f
|
|
info = qmckl_compute_een_rescaled_n_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
cord_num, &
|
|
rescale_factor_en, &
|
|
en_distance, &
|
|
een_rescaled_n)
|
|
|
|
end function qmckl_compute_een_rescaled_n
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_rescaled_n_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_een_rescaled_n (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
int64_t* const type_nucl_vector,
|
|
const int64_t cord_num,
|
|
const double* rescale_factor_en,
|
|
const double* en_distance,
|
|
double* const een_rescaled_n );
|
|
#+end_src
|
|
|
|
*** Test
|
|
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
elec_coord = np.array(elec_coord)[0]
|
|
nucl_coord = np.array(nucl_coord)
|
|
elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for a in range(nucl_num):
|
|
elnuc_dist[i, a] = np.linalg.norm(elec_coord[i] - nucl_coord[:,a])
|
|
|
|
kappa = 1.0
|
|
|
|
een_rescaled_n = np.zeros(shape=(nucl_num, elec_num, cord_num + 1), dtype=float)
|
|
een_rescaled_n[:,:,0] = 1.0
|
|
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
een_rescaled_n[a, i, 1] = np.exp(-kappa * elnuc_dist[i, a])
|
|
|
|
for l in range(2,cord_num+1):
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
een_rescaled_n[a, i, l] = een_rescaled_n[a, i, l - 1] * een_rescaled_n[a, i, 1]
|
|
|
|
print(" een_rescaled_n[0, 2, 1] = ",een_rescaled_n[0, 2, 1])
|
|
print(" een_rescaled_n[0, 3, 1] = ",een_rescaled_n[0, 3, 1])
|
|
print(" een_rescaled_n[0, 4, 1] = ",een_rescaled_n[0, 4, 1])
|
|
print(" een_rescaled_n[1, 3, 2] = ",een_rescaled_n[1, 3, 2])
|
|
print(" een_rescaled_n[1, 4, 2] = ",een_rescaled_n[1, 4, 2])
|
|
print(" een_rescaled_n[1, 5, 2] = ",een_rescaled_n[1, 5, 2])
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: een_rescaled_n[0, 2, 1] = 0.10612983920006765
|
|
: een_rescaled_n[0, 3, 1] = 0.135652809635553
|
|
: een_rescaled_n[0, 4, 1] = 0.023391817607642338
|
|
: een_rescaled_n[1, 3, 2] = 0.880957224822116
|
|
: een_rescaled_n[1, 4, 2] = 0.027185942659395074
|
|
: een_rescaled_n[1, 5, 2] = 0.01343938025140174
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
double een_rescaled_n[walk_num][(cord_num + 1)][nucl_num][elec_num];
|
|
size_max=walk_num*(cord_num + 1)*nucl_num*elec_num;
|
|
rc = qmckl_get_jastrow_een_rescaled_n(context, &(een_rescaled_n[0][0][0][0]),size_max);
|
|
|
|
// value of (0,2,1)
|
|
assert(fabs(een_rescaled_n[0][1][0][2]-0.10612983920006765) < 1.e-12);
|
|
assert(fabs(een_rescaled_n[0][1][0][3]-0.135652809635553) < 1.e-12);
|
|
assert(fabs(een_rescaled_n[0][1][0][4]-0.023391817607642338) < 1.e-12);
|
|
assert(fabs(een_rescaled_n[0][2][1][3]-0.880957224822116) < 1.e-12);
|
|
assert(fabs(een_rescaled_n[0][2][1][4]-0.027185942659395074) < 1.e-12);
|
|
assert(fabs(een_rescaled_n[0][2][1][5]-0.01343938025140174) < 1.e-12);
|
|
#+end_src
|
|
|
|
** Electron-nucleus rescaled distances for each order and derivatives ~een_rescaled_n_deriv_e~ stores the table of the rescaled distances between
|
|
electrons and nucleii raised to the power \(p\) defined by ~cord_num~:
|
|
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_een_rescaled_n_deriv_e(qmckl_context context,
|
|
double* const distance_rescaled,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_een_rescaled_n_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * 4 * ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1);
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_een_deriv_e",
|
|
"Array too small. Expected ctx->electron.num * 4 * ctx->nucleus.num * ctx->electron.walker.num * (ctx->jastrow.cord_num + 1)");
|
|
}
|
|
memcpy(distance_rescaled, ctx->jastrow.een_rescaled_n_deriv_e, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_n_deriv_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_een_rescaled_n_deriv_e(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if ee distance is provided */
|
|
qmckl_exit_code rc = qmckl_provide_en_distance(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if ee distance is provided */
|
|
rc = qmckl_provide_een_rescaled_n(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.een_rescaled_n_deriv_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.een_rescaled_n_deriv_e != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.een_rescaled_n_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_een_rescaled_n_deriv_e",
|
|
"Unable to free ctx->jastrow.een_rescaled_n_deriv_e");
|
|
}
|
|
ctx->jastrow.een_rescaled_n_deriv_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.een_rescaled_n_deriv_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.num * 4 * ctx->nucleus.num *
|
|
ctx->electron.walker.num * (ctx->jastrow.cord_num + 1) * sizeof(double);
|
|
double* een_rescaled_n_deriv_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (een_rescaled_n_deriv_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_een_rescaled_n_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_n_deriv_e = een_rescaled_n_deriv_e;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_een_rescaled_n_deriv_e(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.rescale_factor_en,
|
|
ctx->electron.walker.point.coord.data,
|
|
ctx->nucleus.coord.data,
|
|
ctx->electron.en_distance,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.een_rescaled_n_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.een_rescaled_n_deriv_e_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_een_rescaled_n_deriv_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_compute_factor_een_rescaled_n_deriv_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------+-------------------------------------------------------+--------+-------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of atoms |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | Number of atom types |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | Types of atoms |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~rescale_factor_en~ | ~double[nucl_num]~ | in | Factor to rescale ee distances |
|
|
| ~coord_ee~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates |
|
|
| ~coord_en~ | ~double[3][nucl_num]~ | in | Nuclear coordinates |
|
|
| ~en_distance~ | ~double[walk_num][elec_num][nucl_num]~ | in | Electron-nucleus distances |
|
|
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus distances |
|
|
| ~een_rescaled_n_deriv_e~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | out | Electron-nucleus rescaled distances |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_een_rescaled_n_deriv_e_f( &
|
|
context, walk_num, elec_num, nucl_num, type_nucl_num, type_nucl_vector, &
|
|
cord_num, rescale_factor_en, &
|
|
coord_ee, coord_en, en_distance, een_rescaled_n, een_rescaled_n_deriv_e) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
integer*8 , intent(in) :: cord_num
|
|
double precision , intent(in) :: rescale_factor_en(type_nucl_num)
|
|
double precision , intent(in) :: coord_ee(elec_num,3,walk_num)
|
|
double precision , intent(in) :: coord_en(nucl_num,3)
|
|
double precision , intent(in) :: en_distance(elec_num,nucl_num,walk_num)
|
|
double precision , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
double precision , intent(out) :: een_rescaled_n_deriv_e(elec_num,4,nucl_num,0:cord_num,walk_num)
|
|
double precision,dimension(:,:,:),allocatable :: elnuc_dist_deriv_e
|
|
double precision :: x, ria_inv, kappa_l
|
|
integer*8 :: i, a, k, l, nw, ii
|
|
|
|
allocate(elnuc_dist_deriv_e(4, elec_num, nucl_num))
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
! Prepare table of exponentiated distances raised to appropriate power
|
|
een_rescaled_n_deriv_e = 0.0d0
|
|
do nw = 1, walk_num
|
|
|
|
! prepare the actual een table
|
|
do a = 1, nucl_num
|
|
do i = 1, elec_num
|
|
ria_inv = 1.0d0 / en_distance(i, a, nw)
|
|
do ii = 1, 3
|
|
elnuc_dist_deriv_e(ii, i, a) = (coord_ee(i, ii, nw) - coord_en(a, ii)) * ria_inv
|
|
end do
|
|
elnuc_dist_deriv_e(4, i, a) = 2.0d0 * ria_inv
|
|
end do
|
|
end do
|
|
|
|
do l = 0, cord_num
|
|
do a = 1, nucl_num
|
|
kappa_l = - dble(l) * rescale_factor_en(type_nucl_vector(a))
|
|
do i = 1, elec_num
|
|
een_rescaled_n_deriv_e(i, 1, a, l, nw) = kappa_l * elnuc_dist_deriv_e(1, i, a)
|
|
een_rescaled_n_deriv_e(i, 2, a, l, nw) = kappa_l * elnuc_dist_deriv_e(2, i, a)
|
|
een_rescaled_n_deriv_e(i, 3, a, l, nw) = kappa_l * elnuc_dist_deriv_e(3, i, a)
|
|
een_rescaled_n_deriv_e(i, 4, a, l, nw) = kappa_l * elnuc_dist_deriv_e(4, i, a)
|
|
|
|
een_rescaled_n_deriv_e(i, 4, a, l, nw) = een_rescaled_n_deriv_e(i, 4, a, l, nw) &
|
|
+ een_rescaled_n_deriv_e(i, 1, a, l, nw) * een_rescaled_n_deriv_e(i, 1, a, l, nw) &
|
|
+ een_rescaled_n_deriv_e(i, 2, a, l, nw) * een_rescaled_n_deriv_e(i, 2, a, l, nw) &
|
|
+ een_rescaled_n_deriv_e(i, 3, a, l, nw) * een_rescaled_n_deriv_e(i, 3, a, l, nw)
|
|
|
|
een_rescaled_n_deriv_e(i, 1, a, l, nw) = een_rescaled_n_deriv_e(i, 1, a, l, nw) * &
|
|
een_rescaled_n(i, a, l, nw)
|
|
een_rescaled_n_deriv_e(i, 2, a, l, nw) = een_rescaled_n_deriv_e(i, 2, a, l, nw) * &
|
|
een_rescaled_n(i, a, l, nw)
|
|
een_rescaled_n_deriv_e(i, 3, a, l, nw) = een_rescaled_n_deriv_e(i, 3, a, l, nw) * &
|
|
een_rescaled_n(i, a, l, nw)
|
|
een_rescaled_n_deriv_e(i, 4, a, l, nw) = een_rescaled_n_deriv_e(i, 4, a, l, nw) * &
|
|
een_rescaled_n(i, a, l, nw)
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_een_rescaled_n_deriv_e_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_compute_factor_een_rescaled_n_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_een_rescaled_n_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t type_nucl_num,
|
|
int64_t* const type_nucl_vector,
|
|
const int64_t cord_num,
|
|
const double* rescale_factor_en,
|
|
const double* coord_ee,
|
|
const double* coord_en,
|
|
const double* en_distance,
|
|
const double* een_rescaled_n,
|
|
double* const een_rescaled_n_deriv_e );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_compute_factor_een_rescaled_n_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_een_rescaled_n_deriv_e &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
cord_num, &
|
|
rescale_factor_en, &
|
|
coord_ee, &
|
|
coord_en, &
|
|
en_distance, &
|
|
een_rescaled_n, &
|
|
een_rescaled_n_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
real (c_double ) , intent(in) :: rescale_factor_en(nucl_num)
|
|
real (c_double ) , intent(in) :: coord_ee(elec_num,3,walk_num)
|
|
real (c_double ) , intent(in) :: coord_en(nucl_num,3)
|
|
real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(out) :: een_rescaled_n_deriv_e(elec_num,4,nucl_num,0:cord_num,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_een_rescaled_n_deriv_e_f
|
|
info = qmckl_compute_factor_een_rescaled_n_deriv_e_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
type_nucl_num, &
|
|
type_nucl_vector, &
|
|
cord_num, &
|
|
rescale_factor_en, &
|
|
coord_ee, &
|
|
coord_en, &
|
|
en_distance, &
|
|
een_rescaled_n, &
|
|
een_rescaled_n_deriv_e)
|
|
|
|
end function qmckl_compute_factor_een_rescaled_n_deriv_e
|
|
#+end_src
|
|
|
|
*** Test
|
|
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
elec_coord = np.array(elec_coord)[0]
|
|
nucl_coord = np.array(nucl_coord)
|
|
elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for a in range(nucl_num):
|
|
elnuc_dist[i, a] = np.linalg.norm(elec_coord[i] - nucl_coord[:,a])
|
|
|
|
elnuc_dist_deriv_e = np.zeros(shape=(4, elec_num, nucl_num),dtype=float)
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
rij_inv = 1.0 / elnuc_dist[i, a]
|
|
for ii in range(3):
|
|
elnuc_dist_deriv_e[ii, i, a] = (elec_coord[i][ii] - nucl_coord[ii][a]) * rij_inv
|
|
elnuc_dist_deriv_e[3, i, a] = 2.0 * rij_inv
|
|
|
|
kappa = 1.0
|
|
|
|
een_rescaled_n = np.zeros(shape=(nucl_num, elec_num, cord_num + 1), dtype=float)
|
|
een_rescaled_n[:,:,0] = 1.0
|
|
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
een_rescaled_n[a, i, 1] = np.exp(-kappa * elnuc_dist[i, a])
|
|
|
|
for l in range(2,cord_num+1):
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
een_rescaled_n[a, i, l] = een_rescaled_n[a, i, l - 1] * een_rescaled_n[a, i, 1]
|
|
|
|
een_rescaled_n_deriv_e = np.zeros(shape=(elec_num,4,nucl_num,cord_num+1),dtype=float)
|
|
for l in range(0,cord_num+1):
|
|
kappa_l = -1.0 * kappa * l
|
|
for j in range(0,elec_num):
|
|
for a in range(0,nucl_num):
|
|
for ii in range(0,4):
|
|
een_rescaled_n_deriv_e[j,ii,a,l] = kappa_l * elnuc_dist_deriv_e[ii,j,a]
|
|
een_rescaled_n_deriv_e[j,3,a,l] = een_rescaled_n_deriv_e[j,3,a,l] + \
|
|
een_rescaled_n_deriv_e[j,0,a,l] * een_rescaled_n_deriv_e[j,0,a,l] + \
|
|
een_rescaled_n_deriv_e[j,1,a,l] * een_rescaled_n_deriv_e[j,1,a,l] + \
|
|
een_rescaled_n_deriv_e[j,2,a,l] * een_rescaled_n_deriv_e[j,2,a,l]
|
|
|
|
for ii in range(0,4):
|
|
een_rescaled_n_deriv_e[j,ii,a,l] = een_rescaled_n_deriv_e[j,ii,a,l] * een_rescaled_n[a,j,l]
|
|
|
|
print(" een_rescaled_n_deriv_e[1, 1, 3, 1] = ",een_rescaled_n_deriv_e[2, 0, 0, 1])
|
|
print(" een_rescaled_n_deriv_e[1, 1, 4, 1] = ",een_rescaled_n_deriv_e[3, 0, 0, 1])
|
|
print(" een_rescaled_n_deriv_e[1, 1, 5, 1] = ",een_rescaled_n_deriv_e[4, 0, 0, 1])
|
|
print(" een_rescaled_n_deriv_e[2, 1, 4, 2] = ",een_rescaled_n_deriv_e[3, 0, 1, 2])
|
|
print(" een_rescaled_n_deriv_e[2, 1, 5, 2] = ",een_rescaled_n_deriv_e[4, 0, 1, 2])
|
|
print(" een_rescaled_n_deriv_e[2, 1, 6, 2] = ",een_rescaled_n_deriv_e[5, 0, 1, 2])
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: een_rescaled_n_deriv_e[1, 1, 3, 1] = -0.07633444246999128
|
|
: een_rescaled_n_deriv_e[1, 1, 4, 1] = 0.00033282346259738276
|
|
: een_rescaled_n_deriv_e[1, 1, 5, 1] = -0.004775370547333061
|
|
: een_rescaled_n_deriv_e[2, 1, 4, 2] = 0.1362654644223866
|
|
: een_rescaled_n_deriv_e[2, 1, 5, 2] = -0.0231253431662794
|
|
: een_rescaled_n_deriv_e[2, 1, 6, 2] = 0.001593334817691633
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
double een_rescaled_n_deriv_e[walk_num][(cord_num + 1)][nucl_num][4][elec_num];
|
|
size_max=walk_num*(cord_num + 1)*nucl_num*4*elec_num;
|
|
rc = qmckl_get_jastrow_een_rescaled_n_deriv_e(context, &(een_rescaled_n_deriv_e[0][0][0][0][0]),size_max);
|
|
|
|
// value of (0,2,1)
|
|
assert(fabs(een_rescaled_n_deriv_e[0][1][0][0][2]+0.07633444246999128 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_n_deriv_e[0][1][0][0][3]-0.00033282346259738276) < 1.e-12);
|
|
assert(fabs(een_rescaled_n_deriv_e[0][1][0][0][4]+0.004775370547333061 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_n_deriv_e[0][2][1][0][3]-0.1362654644223866 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_n_deriv_e[0][2][1][0][4]+0.0231253431662794 ) < 1.e-12);
|
|
assert(fabs(een_rescaled_n_deriv_e[0][2][1][0][5]-0.001593334817691633 ) < 1.e-12);
|
|
|
|
#+end_src
|
|
|
|
** Prepare for electron-electron-nucleus Jastrow \(f_{een}\)
|
|
|
|
Prepare ~c_vector_full~ and ~lkpm_combined_index~ tables required for the
|
|
calculation of the three-body jastrow ~factor_een~ and its derivative ~factor_een_deriv_e~.
|
|
|
|
*** Get
|
|
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code qmckl_get_jastrow_dim_c_vector(qmckl_context context, int64_t* const dim_c_vector);
|
|
qmckl_exit_code qmckl_get_jastrow_c_vector_full(qmckl_context context, double* const c_vector_full);
|
|
qmckl_exit_code qmckl_get_jastrow_lkpm_combined_index(qmckl_context context, int64_t* const lkpm_combined_index);
|
|
qmckl_exit_code qmckl_get_jastrow_tmp_c(qmckl_context context, double* const tmp_c);
|
|
qmckl_exit_code qmckl_get_jastrow_dtmp_c(qmckl_context context, double* const dtmp_c);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_get_jastrow_dim_c_vector(qmckl_context context, int64_t* const dim_c_vector)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
*dim_c_vector = ctx->jastrow.dim_c_vector;
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_c_vector_full(qmckl_context context, double* const c_vector_full)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_c_vector_full(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = ctx->jastrow.dim_c_vector * ctx->nucleus.num;
|
|
memcpy(c_vector_full, ctx->jastrow.c_vector_full, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_lkpm_combined_index(qmckl_context context, int64_t* const lkpm_combined_index)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_c_vector_full(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = ctx->jastrow.dim_c_vector * 4;
|
|
memcpy(lkpm_combined_index, ctx->jastrow.lkpm_combined_index, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_tmp_c(qmckl_context context, double* const tmp_c)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_c_vector_full(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
rc = qmckl_provide_tmp_c(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = (ctx->jastrow.cord_num) * (ctx->jastrow.cord_num + 1)
|
|
* ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num;
|
|
memcpy(tmp_c, ctx->jastrow.tmp_c, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_dtmp_c(qmckl_context context, double* const dtmp_c)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_jastrow_c_vector_full(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
rc = qmckl_provide_dtmp_c(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = (ctx->jastrow.cord_num) * (ctx->jastrow.cord_num + 1)
|
|
*4* ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num;
|
|
memcpy(dtmp_c, ctx->jastrow.dtmp_c, sze * sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_c_vector_full(qmckl_context context);
|
|
qmckl_exit_code qmckl_provide_lkpm_combined_index(qmckl_context context);
|
|
qmckl_exit_code qmckl_provide_tmp_c(qmckl_context context);
|
|
qmckl_exit_code qmckl_provide_dtmp_c(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_jastrow_c_vector_full(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.c_vector_full_date) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.c_vector_full == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->jastrow.dim_c_vector * ctx->nucleus.num * sizeof(double);
|
|
double* c_vector_full = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (c_vector_full == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_jastrow_c_vector_full",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.c_vector_full = c_vector_full;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
rc = qmckl_compute_c_vector_full(context,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.dim_c_vector,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.c_vector,
|
|
ctx->jastrow.c_vector_full);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.c_vector_full_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_provide_lkpm_combined_index(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.lkpm_combined_index_date) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.lkpm_combined_index == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = 4 * ctx->jastrow.dim_c_vector * sizeof(int64_t);
|
|
int64_t* lkpm_combined_index = (int64_t*) qmckl_malloc(context, mem_info);
|
|
|
|
if (lkpm_combined_index == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_lkpm_combined_index",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.lkpm_combined_index = lkpm_combined_index;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
rc = qmckl_compute_lkpm_combined_index(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.dim_c_vector,
|
|
ctx->jastrow.lkpm_combined_index);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.lkpm_combined_index_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_provide_tmp_c(qmckl_context context)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
qmckl_exit_code rc = QMCKL_SUCCESS;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.tmp_c_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.tmp_c != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.tmp_c);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_tmp_c",
|
|
"Unable to free ctx->jastrow.tmp_c");
|
|
}
|
|
ctx->jastrow.tmp_c = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.tmp_c == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = (ctx->jastrow.cord_num) * (ctx->jastrow.cord_num + 1)
|
|
,* ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num * sizeof(double);
|
|
double* tmp_c = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (tmp_c == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_tmp_c",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.tmp_c = tmp_c;
|
|
}
|
|
|
|
|
|
/* Choose the correct compute function (depending on offload type) */
|
|
#ifdef HAVE_HPC
|
|
const bool gpu_offload = ctx->jastrow.gpu_offload;
|
|
#else
|
|
const bool gpu_offload = false;
|
|
#endif
|
|
|
|
if (gpu_offload) {
|
|
#ifdef HAVE_CUBLAS_OFFLOAD
|
|
rc = qmckl_compute_tmp_c_cublas_offload(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.tmp_c);
|
|
#elif HAVE_OPENACC_OFFLOAD
|
|
rc = qmckl_compute_tmp_c_acc_offload(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.tmp_c);
|
|
#elif HAVE_OPENMP_OFFLOAD
|
|
rc = qmckl_compute_tmp_c_omp_offload(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.tmp_c);
|
|
#else
|
|
rc = QMCKL_FAILURE;
|
|
#endif
|
|
} else {
|
|
rc = qmckl_compute_tmp_c(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.tmp_c);
|
|
}
|
|
|
|
|
|
ctx->jastrow.tmp_c_date = ctx->date;
|
|
}
|
|
|
|
return rc;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_provide_dtmp_c(qmckl_context context)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.dtmp_c_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.dtmp_c != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.dtmp_c);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_dtmp_c",
|
|
"Unable to free ctx->jastrow.dtmp_c");
|
|
}
|
|
ctx->jastrow.dtmp_c = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.dtmp_c == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = (ctx->jastrow.cord_num) * (ctx->jastrow.cord_num + 1)
|
|
,* 4 * ctx->electron.num * ctx->nucleus.num * ctx->electron.walker.num * sizeof(double);
|
|
double* dtmp_c = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (dtmp_c == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_dtmp_c",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.dtmp_c = dtmp_c;
|
|
}
|
|
|
|
|
|
#ifdef HAVE_HPC
|
|
const bool gpu_offload = ctx->jastrow.gpu_offload;
|
|
#else
|
|
const bool gpu_offload = false;
|
|
#endif
|
|
|
|
if (gpu_offload) {
|
|
#ifdef HAVE_CUBLAS_OFFLOAD
|
|
rc = qmckl_compute_dtmp_c_cublas_offload(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e_deriv_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.dtmp_c);
|
|
#elif HAVE_OPENACC_OFFLOAD
|
|
rc = qmckl_compute_dtmp_c_acc_offload(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e_deriv_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.dtmp_c);
|
|
#elif HAVE_OPENMP_OFFLOAD
|
|
rc = qmckl_compute_dtmp_c_omp_offload(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e_deriv_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.dtmp_c);
|
|
#else
|
|
rc = QMCKL_FAILURE;
|
|
#endif
|
|
} else {
|
|
rc = qmckl_compute_dtmp_c(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walker.num,
|
|
ctx->jastrow.een_rescaled_e_deriv_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.dtmp_c);
|
|
}
|
|
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
|
|
ctx->jastrow.dtmp_c_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute dim_c_vector
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_dim_c_vector
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_dim_c_vector_args
|
|
| Variable | Type | In/Out | Description |
|
|
|-----------------+-----------------+--------+-----------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~dim_c_vector~ | ~int64_t~ | out | dimension of c_vector_full table |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_dim_c_vector_f( &
|
|
context, cord_num, dim_c_vector) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: cord_num
|
|
integer*8 , intent(out) :: dim_c_vector
|
|
double precision :: x
|
|
integer*8 :: i, a, k, l, p, lmax
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
dim_c_vector = 0
|
|
|
|
do p = 2, cord_num
|
|
do k = p - 1, 0, -1
|
|
if (k .ne. 0) then
|
|
lmax = p - k
|
|
else
|
|
lmax = p - k - 2
|
|
endif
|
|
do l = lmax, 0, -1
|
|
if (iand(p - k - l, 1_8) == 1) cycle
|
|
dim_c_vector = dim_c_vector + 1
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_dim_c_vector_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_dim_c_vector (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
int64_t* const dim_c_vector){
|
|
|
|
int lmax;
|
|
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
*dim_c_vector = 0;
|
|
|
|
for (int p=2; p <= cord_num; ++p){
|
|
for (int k=p-1; k >= 0; --k) {
|
|
if (k != 0) {
|
|
lmax = p - k;
|
|
} else {
|
|
lmax = p - k - 2;
|
|
}
|
|
for (int l = lmax; l >= 0; --l) {
|
|
if ( ((p - k - l) & 1)==1) continue;
|
|
*dim_c_vector=*dim_c_vector+1;
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_dim_c_vector_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_dim_c_vector (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
int64_t* const dim_c_vector );
|
|
#+end_src
|
|
|
|
*** Compute c_vector_full
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_c_vector_full
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_c_vector_full_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------+----------------------------------------+--------+------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of atoms |
|
|
| ~dim_c_vector~ | ~int64_t~ | in | dimension of cord full table |
|
|
| ~type_nucl_num~ | ~int64_t~ | in | dimension of cord full table |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | dimension of cord full table |
|
|
| ~c_vector~ | ~double[dim_c_vector][type_nucl_num]~ | in | dimension of cord full table |
|
|
| ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | out | Full list of coefficients |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_c_vector_full_doc_f( &
|
|
context, nucl_num, dim_c_vector, type_nucl_num, &
|
|
type_nucl_vector, c_vector, c_vector_full) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: dim_c_vector
|
|
integer*8 , intent(in) :: type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
double precision , intent(in) :: c_vector(type_nucl_num, dim_c_vector)
|
|
double precision , intent(out) :: c_vector_full(nucl_num,dim_c_vector)
|
|
double precision :: x
|
|
integer*8 :: i, a, k, l, nw
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (type_nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (dim_c_vector < 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
|
|
do a = 1, nucl_num
|
|
c_vector_full(a,1:dim_c_vector) = c_vector(type_nucl_vector(a),1:dim_c_vector)
|
|
end do
|
|
|
|
end function qmckl_compute_c_vector_full_doc_f
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_c_vector_full_args,rettyp=get_value("CRetType"),fname="qmckl_compute_c_vector_full_doc")
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_c_vector_full_doc &
|
|
(context, nucl_num, dim_c_vector, type_nucl_num, type_nucl_vector, c_vector, c_vector_full) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: dim_c_vector
|
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
real (c_double ) , intent(in) :: c_vector(type_nucl_num,dim_c_vector)
|
|
real (c_double ) , intent(out) :: c_vector_full(nucl_num,dim_c_vector)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_c_vector_full_doc_f
|
|
info = qmckl_compute_c_vector_full_doc_f &
|
|
(context, nucl_num, dim_c_vector, type_nucl_num, type_nucl_vector, c_vector, c_vector_full)
|
|
|
|
end function qmckl_compute_c_vector_full_doc
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_c_vector_full_hpc (
|
|
const qmckl_context context,
|
|
const int64_t nucl_num,
|
|
const int64_t dim_c_vector,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const double* c_vector,
|
|
double* const c_vector_full ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (type_nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
if (dim_c_vector < 0) {
|
|
return QMCKL_INVALID_ARG_5;
|
|
}
|
|
|
|
for (int i=0; i < dim_c_vector; ++i) {
|
|
for (int a=0; a < nucl_num; ++a){
|
|
c_vector_full[a + i*nucl_num] = c_vector[(type_nucl_vector[a]-1)+i*type_nucl_num];
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_c_vector_full_args,rettyp=get_value("CRetType"),fname="qmckl_compute_c_vector_full_doc")
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_c_vector_full (
|
|
const qmckl_context context,
|
|
const int64_t nucl_num,
|
|
const int64_t dim_c_vector,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const double* c_vector,
|
|
double* const c_vector_full );
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_c_vector_full_doc (
|
|
const qmckl_context context,
|
|
const int64_t nucl_num,
|
|
const int64_t dim_c_vector,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const double* c_vector,
|
|
double* const c_vector_full );
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_c_vector_full_hpc (
|
|
const qmckl_context context,
|
|
const int64_t nucl_num,
|
|
const int64_t dim_c_vector,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const double* c_vector,
|
|
double* const c_vector_full );
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_c_vector_full (
|
|
const qmckl_context context,
|
|
const int64_t nucl_num,
|
|
const int64_t dim_c_vector,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const double* c_vector,
|
|
double* const c_vector_full ) {
|
|
|
|
#ifdef HAVE_HPC
|
|
return qmckl_compute_c_vector_full_hpc(context, nucl_num, dim_c_vector, type_nucl_num, type_nucl_vector, c_vector, c_vector_full);
|
|
#else
|
|
return qmckl_compute_c_vector_full_doc(context, nucl_num, dim_c_vector, type_nucl_num, type_nucl_vector, c_vector, c_vector_full);
|
|
#endif
|
|
}
|
|
#+end_src
|
|
|
|
|
|
*** Compute lkpm_combined_index
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_lkpm_combined_index
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_lkpm_combined_index_args
|
|
| Variable | Type | In/Out | Description |
|
|
|-----------------------+-----------------------------+--------+-------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~dim_c_vector~ | ~int64_t~ | in | dimension of cord full table |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | out | Full list of combined indices |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_lkpm_combined_index_f( &
|
|
context, cord_num, dim_c_vector, lkpm_combined_index) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: cord_num
|
|
integer*8 , intent(in) :: dim_c_vector
|
|
integer*8 , intent(out) :: lkpm_combined_index(dim_c_vector, 4)
|
|
double precision :: x
|
|
integer*8 :: i, a, k, l, kk, p, lmax, m
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (dim_c_vector < 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
|
|
kk = 0
|
|
do p = 2, cord_num
|
|
do k = p - 1, 0, -1
|
|
if (k .ne. 0) then
|
|
lmax = p - k
|
|
else
|
|
lmax = p - k - 2
|
|
end if
|
|
do l = lmax, 0, -1
|
|
if (iand(p - k - l, 1_8) .eq. 1) cycle
|
|
m = (p - k - l)/2
|
|
kk = kk + 1
|
|
lkpm_combined_index(kk, 1) = l
|
|
lkpm_combined_index(kk, 2) = k
|
|
lkpm_combined_index(kk, 3) = p
|
|
lkpm_combined_index(kk, 4) = m
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_lkpm_combined_index_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_lkpm_combined_index (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t dim_c_vector,
|
|
int64_t* const lkpm_combined_index ) {
|
|
|
|
int kk, lmax, m;
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (dim_c_vector < 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
/*
|
|
*/
|
|
kk = 0;
|
|
for (int p = 2; p <= cord_num; ++p) {
|
|
for (int k=(p-1); k >= 0; --k) {
|
|
if (k != 0) {
|
|
lmax = p - k;
|
|
} else {
|
|
lmax = p - k - 2;
|
|
}
|
|
for (int l=lmax; l >= 0; --l) {
|
|
if (((p - k - l) & 1) == 1) continue;
|
|
m = (p - k - l)/2;
|
|
lkpm_combined_index[kk ] = l;
|
|
lkpm_combined_index[kk + dim_c_vector] = k;
|
|
lkpm_combined_index[kk + 2*dim_c_vector] = p;
|
|
lkpm_combined_index[kk + 3*dim_c_vector] = m;
|
|
kk = kk + 1;
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_lkpm_combined_index_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_lkpm_combined_index (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t dim_c_vector,
|
|
int64_t* const lkpm_combined_index );
|
|
#+end_src
|
|
|
|
|
|
*** Compute tmp_c
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_tmp_c
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_tmp_c_args
|
|
| Variable | Type | In/Out | Description |
|
|
|------------------+------------------------------------------------------------------+--------+-----------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~een_rescaled_e~ | ~double[walk_num][0:cord_num][elec_num][elec_num]~ | in | Electron-electron rescaled factor |
|
|
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor |
|
|
| ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients |
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_tmp_c (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c )
|
|
{
|
|
#ifdef HAVE_HPC
|
|
return qmckl_compute_tmp_c_hpc(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c);
|
|
#else
|
|
return qmckl_compute_tmp_c_doc(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c);
|
|
#endif
|
|
}
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_tmp_c_args,rettyp=get_value("CRetType"),fname="qmckl_compute_tmp_c")
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_tmp_c (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#+end_src
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_tmp_c_doc_f( &
|
|
context, cord_num, elec_num, nucl_num, &
|
|
walk_num, een_rescaled_e, een_rescaled_n, tmp_c) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: cord_num
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: walk_num
|
|
double precision , intent(in) :: een_rescaled_e(elec_num, elec_num, 0:cord_num, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
|
|
double precision , intent(out) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
|
|
double precision :: x
|
|
integer*8 :: i, j, a, l, kk, p, lmax, nw
|
|
character :: TransA, TransB
|
|
double precision :: alpha, beta
|
|
integer*8 :: M, N, K, LDA, LDB, LDC
|
|
|
|
TransA = 'N'
|
|
TransB = 'N'
|
|
alpha = 1.0d0
|
|
beta = 0.0d0
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
M = elec_num
|
|
N = nucl_num*(cord_num + 1)
|
|
K = elec_num
|
|
LDA = size(een_rescaled_e,1)
|
|
LDB = size(een_rescaled_n,1)
|
|
LDC = size(tmp_c,1)
|
|
|
|
do nw=1, walk_num
|
|
do i=0, cord_num-1
|
|
info = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha, &
|
|
een_rescaled_e(1,1,i,nw),LDA*1_8, &
|
|
een_rescaled_n(1,1,0,nw),LDB*1_8, &
|
|
beta, &
|
|
tmp_c(1,1,0,i,nw),LDC)
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_tmp_c_doc_f
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_tmp_c_doc (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_tmp_c_args,rettyp=get_value("FRetType"),fname="qmckl_compute_tmp_c_doc")
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_tmp_c_doc &
|
|
(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
real (c_double ) , intent(in) :: een_rescaled_e(elec_num,elec_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(out) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_tmp_c_doc_f
|
|
info = qmckl_compute_tmp_c_doc_f &
|
|
(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c)
|
|
|
|
end function qmckl_compute_tmp_c_doc
|
|
#+end_src
|
|
|
|
**** CPU :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_tmp_c_hpc (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_5;
|
|
}
|
|
|
|
qmckl_exit_code info = QMCKL_SUCCESS;
|
|
|
|
const char TransA = 'N';
|
|
const char TransB = 'N';
|
|
const double alpha = 1.0;
|
|
const double beta = 0.0;
|
|
|
|
const int64_t M = elec_num;
|
|
const int64_t N = nucl_num*(cord_num + 1);
|
|
const int64_t K = elec_num;
|
|
|
|
const int64_t LDA = elec_num;
|
|
const int64_t LDB = elec_num;
|
|
const int64_t LDC = elec_num;
|
|
|
|
const int64_t af = elec_num*elec_num;
|
|
const int64_t bf = elec_num*nucl_num*(cord_num+1);
|
|
const int64_t cf = bf;
|
|
|
|
#ifdef HAVE_OPENMP
|
|
#pragma omp parallel for collapse(2)
|
|
#endif
|
|
for (int64_t nw=0; nw < walk_num; ++nw) {
|
|
for (int64_t i=0; i<cord_num; ++i){
|
|
info = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha,
|
|
&(een_rescaled_e[af*(i+nw*(cord_num+1))]), LDA,
|
|
&(een_rescaled_n[bf*nw]), LDB, beta,
|
|
&(tmp_c[cf*(i+nw*cord_num)]), LDC);
|
|
}
|
|
}
|
|
|
|
return info;
|
|
}
|
|
#+end_src
|
|
|
|
|
|
|
|
#+CALL: generate_c_header(table=qmckl_factor_tmp_c_args,rettyp=get_value("CRetType"),fname="qmckl_compute_tmp_c")
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code qmckl_compute_tmp_c (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_tmp_c_args,rettyp=get_value("CRetType"),fname="qmckl_compute_tmp_c_doc")
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_tmp_c_doc (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_tmp_c_args,rettyp=get_value("CRetType"),fname="qmckl_compute_tmp_c_hpc")
|
|
|
|
#+RESULTS:
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
qmckl_exit_code qmckl_compute_tmp_c_hpc (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#+end_src
|
|
|
|
**** OpenACC offload :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
#ifdef HAVE_OPENACC_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_tmp_c_acc_offload (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c )
|
|
{
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
// Compute array access strides:
|
|
// For tmp_c...
|
|
const int64_t stride_k_c = elec_num;
|
|
const int64_t stride_j_c = stride_k_c * nucl_num;
|
|
const int64_t stride_i_c = stride_j_c * (cord_num+1);
|
|
const int64_t stride_nw_c = stride_i_c * cord_num;
|
|
// For een_rescaled_e...
|
|
const int64_t stride_m_e = elec_num;
|
|
const int64_t stride_i_e = stride_m_e * elec_num;
|
|
const int64_t stride_nw_e = stride_i_e * (cord_num+1);
|
|
// For een_rescaled_n...
|
|
const int64_t stride_k_n = elec_num;
|
|
const int64_t stride_j_n = stride_k_n * nucl_num;
|
|
const int64_t stride_nw_n = stride_j_n * (cord_num+1);
|
|
|
|
const int64_t size_tmp_c = elec_num*nucl_num*(cord_num+1)*cord_num*walk_num;
|
|
const int64_t size_e = walk_num*(cord_num+1)*elec_num*elec_num;
|
|
const int64_t size_n = walk_num*(cord_num+1)*nucl_num*elec_num;
|
|
|
|
#pragma acc parallel copyout(tmp_c [0:size_tmp_c]) copyin(een_rescaled_e[0:size_e], een_rescaled_n[0:size_n])
|
|
{
|
|
#pragma acc loop independent gang worker vector collapse(5)
|
|
for (int nw=0; nw < walk_num; ++nw) {
|
|
for (int i=0; i<cord_num; ++i){
|
|
|
|
// Replacement for single DGEMM
|
|
for (int j=0; j<cord_num+1; j++) {
|
|
for (int k=0; k<nucl_num; k++) {
|
|
for (int l=0; l<elec_num; l++) {
|
|
|
|
// Single reduction
|
|
tmp_c[l + k*stride_k_c + j*stride_j_c + i*stride_i_c + nw*stride_nw_c] = 0.;
|
|
for (int m=0; m<elec_num; m++) {
|
|
tmp_c[l + k*stride_k_c + j*stride_j_c + i*stride_i_c + nw*stride_nw_c] =
|
|
tmp_c[l + k*stride_k_c + j*stride_j_c + i*stride_i_c + nw*stride_nw_c] +
|
|
een_rescaled_e[l + m*stride_m_e + i*stride_i_e + nw*stride_nw_e] *
|
|
een_rescaled_n[m + k*stride_k_n + j*stride_j_n + nw*stride_nw_n];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#endif
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
#ifdef HAVE_OPENACC_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_tmp_c_acc_offload (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#endif
|
|
#+end_src
|
|
|
|
**** OpenMP offload :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
#ifdef HAVE_OPENMP_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_tmp_c_omp_offload (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c )
|
|
{
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
// Compute array access strides:
|
|
// For tmp_c...
|
|
const int64_t stride_k_c = elec_num;
|
|
const int64_t stride_j_c = stride_k_c * nucl_num;
|
|
const int64_t stride_i_c = stride_j_c * (cord_num+1);
|
|
const int64_t stride_nw_c = stride_i_c * cord_num;
|
|
// For een_rescaled_e...
|
|
const int64_t stride_m_e = elec_num;
|
|
const int64_t stride_i_e = stride_m_e * elec_num;
|
|
const int64_t stride_nw_e = stride_i_e * (cord_num+1);
|
|
// For een_rescaled_n...
|
|
const int64_t stride_k_n = elec_num;
|
|
const int64_t stride_j_n = stride_k_n * nucl_num;
|
|
const int64_t stride_nw_n = stride_j_n * (cord_num+1);
|
|
|
|
const int64_t size_tmp_c = elec_num*nucl_num*(cord_num+1)*cord_num*walk_num;
|
|
const int64_t size_e = walk_num*(cord_num+1)*elec_num*elec_num;
|
|
const int64_t size_n = walk_num*(cord_num+1)*nucl_num*elec_num;
|
|
|
|
|
|
// WARNING This implementation seems unomptimized
|
|
#pragma omp target map(from:tmp_c[0:size_tmp_c]) map(to:een_rescaled_e[0:size_e], een_rescaled_n[0:size_n])
|
|
{
|
|
#pragma omp teams distribute parallel for collapse(5)
|
|
for (int nw=0; nw < walk_num; ++nw) {
|
|
for (int i=0; i<cord_num; ++i){
|
|
|
|
// Replacement for single DGEMM
|
|
for (int j=0; j<cord_num+1; j++) {
|
|
for (int k=0; k<nucl_num; k++) {
|
|
for (int l=0; l<elec_num; l++) {
|
|
|
|
// Single reduction
|
|
tmp_c[l + k*stride_k_c + j*stride_j_c + i*stride_i_c + nw*stride_nw_c] = 0.;
|
|
for (int m=0; m<elec_num; m++) {
|
|
tmp_c[l + k*stride_k_c + j*stride_j_c + i*stride_i_c + nw*stride_nw_c] =
|
|
tmp_c[l + k*stride_k_c + j*stride_j_c + i*stride_i_c + nw*stride_nw_c] +
|
|
een_rescaled_e[l + m*stride_m_e + i*stride_i_e + nw*stride_nw_e] *
|
|
een_rescaled_n[m + k*stride_k_n + j*stride_j_n + nw*stride_nw_n];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#endif
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
#ifdef HAVE_OPENMP_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_tmp_c_omp_offload (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#endif
|
|
#+end_src
|
|
|
|
**** cuBLAS offload :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
#ifdef HAVE_CUBLAS_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_tmp_c_cublas_offload (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c )
|
|
{
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
//cuBLAS initialization
|
|
cublasHandle_t handle;
|
|
if (cublasCreate(&handle) != CUBLAS_STATUS_SUCCESS)
|
|
{
|
|
fprintf(stdout, "CUBLAS initialization failed!\n");
|
|
exit(EXIT_FAILURE);
|
|
}
|
|
|
|
const double alpha = 1.0;
|
|
const double beta = 0.0;
|
|
|
|
const int64_t M = elec_num;
|
|
const int64_t N = nucl_num*(cord_num + 1);
|
|
const int64_t K = elec_num;
|
|
|
|
const int64_t LDA = elec_num;
|
|
const int64_t LDB = elec_num;
|
|
const int64_t LDC = elec_num;
|
|
|
|
const int64_t af = elec_num*elec_num;
|
|
const int64_t bf = elec_num*nucl_num*(cord_num+1);
|
|
const int64_t cf = bf;
|
|
|
|
#pragma omp target enter data map(to:een_rescaled_e[0:elec_num*elec_num*(cord_num+1)*walk_num],een_rescaled_n[0:M*N*walk_num],tmp_c[0:elec_num*nucl_num*(cord_num+1)*cord_num*walk_num])
|
|
#pragma omp target data use_device_ptr(een_rescaled_e,een_rescaled_n,tmp_c)
|
|
{
|
|
for (int nw=0; nw < walk_num; ++nw) {
|
|
|
|
// /!\ cublasError needs to be checked and return QMCKL_FAILURE if it fails
|
|
int cublasError = cublasDgemmStridedBatched(handle, CUBLAS_OP_N, CUBLAS_OP_N, M, N, K, &alpha,
|
|
&(een_rescaled_e[nw*(cord_num+1)]),
|
|
LDA, af,
|
|
&(een_rescaled_n[bf*nw]),
|
|
LDB, 0,
|
|
&beta,
|
|
&(tmp_c[nw*cord_num]),
|
|
LDC, cf, cord_num);
|
|
}
|
|
}
|
|
#pragma omp target exit data map(from:tmp_c[0:elec_num*nucl_num*(cord_num+1)*cord_num*walk_num])
|
|
|
|
cublasDestroy(handle);
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#endif
|
|
|
|
#+end_src
|
|
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
#ifdef HAVE_CUBLAS_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_tmp_c_cublas_offload (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const tmp_c );
|
|
#endif
|
|
#+end_src
|
|
|
|
*** Compute dtmp_c
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_dtmp_c
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_dtmp_c_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------+------------------------------------------------------------------+--------+-----------------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~een_rescaled_e_deriv_e~ | ~double[walk_num][0:cord_num][elec_num][4][elec_num]~ | in | Electron-electron rescaled factor derivatives |
|
|
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor |
|
|
| ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | out | vector of non-zero coefficients |
|
|
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_compute_dtmp_c (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c );
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_compute_dtmp_c (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c )
|
|
{
|
|
#ifdef HAVE_HPC
|
|
return qmckl_compute_dtmp_c_hpc (context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e_deriv_e,
|
|
een_rescaled_n, dtmp_c );
|
|
#else
|
|
return qmckl_compute_dtmp_c_doc (context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e_deriv_e,
|
|
een_rescaled_n, dtmp_c );
|
|
#endif
|
|
}
|
|
#+end_src
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_dtmp_c_doc_f( &
|
|
context, cord_num, elec_num, nucl_num, &
|
|
walk_num, een_rescaled_e_deriv_e, een_rescaled_n, dtmp_c) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: cord_num
|
|
integer*8 , intent(in) :: elec_num
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: walk_num
|
|
double precision , intent(in) :: een_rescaled_e_deriv_e(elec_num, 4, elec_num, 0:cord_num, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
|
|
double precision , intent(out) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
|
|
double precision :: x
|
|
integer*8 :: i, j, a, l, kk, p, lmax, nw, ii
|
|
character :: TransA, TransB
|
|
double precision :: alpha, beta
|
|
integer*8 :: M, N, K, LDA, LDB, LDC
|
|
|
|
TransA = 'N'
|
|
TransB = 'N'
|
|
alpha = 1.0d0
|
|
beta = 0.0d0
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
M = 4*elec_num
|
|
N = nucl_num*(cord_num + 1)
|
|
K = elec_num
|
|
LDA = 4*size(een_rescaled_e_deriv_e,1)
|
|
LDB = size(een_rescaled_n,1)
|
|
LDC = 4*size(dtmp_c,1)
|
|
|
|
do nw=1, walk_num
|
|
do i=0, cord_num-1
|
|
info = qmckl_dgemm(context,TransA, TransB, M, N, K, alpha, &
|
|
een_rescaled_e_deriv_e(1,1,1,i,nw),LDA*1_8, &
|
|
een_rescaled_n(1,1,0,nw),LDB*1_8, &
|
|
beta, &
|
|
dtmp_c(1,1,1,0,i,nw),LDC)
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_dtmp_c_doc_f
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_dtmp_c_args,rettyp=get_value("FRetType"),fname="qmckl_compute_dtmp_c_doc")
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_dtmp_c_doc &
|
|
(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e_deriv_e, een_rescaled_n, dtmp_c) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
real (c_double ) , intent(in) :: een_rescaled_e_deriv_e(elec_num,4,elec_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(out) :: dtmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_dtmp_c_doc_f
|
|
info = qmckl_compute_dtmp_c_doc_f &
|
|
(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e_deriv_e, een_rescaled_n, dtmp_c)
|
|
|
|
end function qmckl_compute_dtmp_c_doc
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_dtmp_c_doc (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c );
|
|
#+end_src
|
|
|
|
**** CPU :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_compute_dtmp_c_hpc (const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c )
|
|
{
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_5;
|
|
}
|
|
|
|
qmckl_exit_code info = QMCKL_SUCCESS;
|
|
|
|
const char TransA = 'N';
|
|
const char TransB = 'N';
|
|
const double alpha = 1.0;
|
|
const double beta = 0.0;
|
|
|
|
const int64_t M = 4*elec_num;
|
|
const int64_t N = nucl_num*(cord_num + 1);
|
|
const int64_t K = elec_num;
|
|
|
|
const int64_t LDA = 4*elec_num;
|
|
const int64_t LDB = elec_num;
|
|
const int64_t LDC = 4*elec_num;
|
|
|
|
const int64_t af = elec_num*elec_num*4;
|
|
const int64_t bf = elec_num*nucl_num*(cord_num+1);
|
|
const int64_t cf = elec_num*4*nucl_num*(cord_num+1);
|
|
|
|
#ifdef HAVE_OPENMP
|
|
#pragma omp parallel for collapse(2)
|
|
#endif
|
|
for (int64_t nw=0; nw < walk_num; ++nw) {
|
|
for (int64_t i=0; i < cord_num; ++i) {
|
|
info = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha,
|
|
&(een_rescaled_e_deriv_e[af*(i+nw*(cord_num+1))]), LDA,
|
|
&(een_rescaled_n[bf*nw]), LDB, beta,
|
|
&(dtmp_c[cf*(i+nw*cord_num)]), LDC);
|
|
}
|
|
}
|
|
|
|
return info;
|
|
}
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_dtmp_c_hpc (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c );
|
|
#+end_src
|
|
|
|
**** OpenACC offload :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
#ifdef HAVE_OPENACC_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_dtmp_c_acc_offload (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
// Compute strides...
|
|
// For dtmp_c
|
|
const int64_t stride_l_d = elec_num;
|
|
const int64_t stride_k_d = stride_l_d * 4;
|
|
const int64_t stride_j_d = stride_k_d * nucl_num;
|
|
const int64_t stride_i_d = stride_j_d * (cord_num+1);
|
|
const int64_t stride_nw_d = stride_i_d * cord_num;
|
|
// For een_rescaled_e_deriv_e
|
|
const int64_t stride_l_e = elec_num;
|
|
const int64_t stride_n_e = stride_l_e * 4;
|
|
const int64_t stride_i_e = stride_n_e * elec_num;
|
|
const int64_t stride_nw_e = stride_i_e * cord_num;
|
|
// For een_rescaled_n
|
|
const int64_t stride_k_n = elec_num;
|
|
const int64_t stride_j_n = stride_k_n * nucl_num;
|
|
const int64_t stride_nw_n = stride_j_n * (cord_num+1);
|
|
|
|
const int64_t size_dtmp_c = walk_num*cord_num*(cord_num+1)*nucl_num*4*elec_num;
|
|
const int64_t size_n = walk_num*(cord_num+1)*nucl_num*elec_num;
|
|
const int64_t size_e = walk_num*(cord_num+1)*elec_num*4*elec_num;
|
|
|
|
#pragma acc parallel copyout(dtmp_c [0:size_dtmp_c]) copyin(een_rescaled_e_deriv_e[0:size_e], een_rescaled_n[0:size_n])
|
|
{
|
|
#pragma acc loop independent gang worker vector collapse(6)
|
|
for (int nw=0; nw < walk_num; nw++) {
|
|
for (int i=0; i < cord_num; i++) {
|
|
|
|
// Single DGEMM
|
|
for(int j=0; j<cord_num+1; j++) {
|
|
for(int k=0; k<nucl_num; k++) {
|
|
for(int l=0; l<4; l++) {
|
|
for(int m=0; m<elec_num; m++) {
|
|
|
|
// Single reduction
|
|
dtmp_c[m + l * stride_l_d + k * stride_k_d + j * stride_j_d + i * stride_i_d + nw * stride_nw_d] = 0.;
|
|
for(int n=0; n<elec_num; n++){
|
|
dtmp_c[m + l * stride_l_d + k * stride_k_d + j * stride_j_d + i * stride_i_d + nw * stride_nw_d] =
|
|
dtmp_c[m + l * stride_l_d + k * stride_k_d + j * stride_j_d + i * stride_i_d + nw * stride_nw_d] +
|
|
een_rescaled_e_deriv_e[m + l * stride_l_e + n * stride_n_e + i * stride_i_e + nw * stride_nw_e] *
|
|
een_rescaled_n[n + k * stride_k_n + j * stride_j_n + nw * stride_nw_n];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#endif
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
#ifdef HAVE_OPENACC_OFFLOAD
|
|
qmckl_exit_code qmckl_compute_dtmp_c_acc_offload (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c );
|
|
#endif
|
|
#+end_src
|
|
|
|
**** OpenMP offload :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
#ifdef HAVE_OPENMP_OFFLOAD
|
|
qmckl_exit_code qmckl_compute_dtmp_c_omp_offload (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
// Compute strides...
|
|
// For dtmp_c
|
|
const int64_t stride_l_d = elec_num;
|
|
const int64_t stride_k_d = stride_l_d * 4;
|
|
const int64_t stride_j_d = stride_k_d * nucl_num;
|
|
const int64_t stride_i_d = stride_j_d * (cord_num+1);
|
|
const int64_t stride_nw_d = stride_i_d * cord_num;
|
|
// For een_rescaled_e_deriv_e
|
|
const int64_t stride_l_e = elec_num;
|
|
const int64_t stride_n_e = stride_l_e * 4;
|
|
const int64_t stride_i_e = stride_n_e * elec_num;
|
|
const int64_t stride_nw_e = stride_i_e * cord_num;
|
|
// For een_rescaled_n
|
|
const int64_t stride_k_n = elec_num;
|
|
const int64_t stride_j_n = stride_k_n * nucl_num;
|
|
const int64_t stride_nw_n = stride_j_n * (cord_num+1);
|
|
|
|
|
|
const int64_t size_dtmp_c = walk_num*cord_num*(cord_num+1)*nucl_num*4*elec_num;
|
|
const int64_t size_n = walk_num*(cord_num+1)*nucl_num*elec_num;
|
|
const int64_t size_e = walk_num*(cord_num+1)*elec_num*4*elec_num;
|
|
|
|
// WARNING This implementation seems unomptimized
|
|
#pragma omp target map(from:dtmp_c[0:size_dtmp_c]) map(to:een_rescaled_e_deriv_e[0:size_e], een_rescaled_n[0:size_n])
|
|
{
|
|
|
|
#pragma omp teams distribute parallel for collapse(6)
|
|
for (int nw=0; nw < walk_num; nw++) {
|
|
for (int i=0; i < cord_num; i++) {
|
|
|
|
// Single DGEMM
|
|
for(int j=0; j<cord_num+1; j++) {
|
|
for(int k=0; k<nucl_num; k++) {
|
|
for(int l=0; l<4; l++) {
|
|
for(int m=0; m<elec_num; m++) {
|
|
|
|
// Single reduction
|
|
dtmp_c[m + l * stride_l_d + k * stride_k_d + j * stride_j_d + i * stride_i_d + nw * stride_nw_d] = 0;
|
|
for(int n=0; n<elec_num; n++){
|
|
dtmp_c[m + l * stride_l_d + k * stride_k_d + j * stride_j_d + i * stride_i_d + nw * stride_nw_d] =
|
|
dtmp_c[m + l * stride_l_d + k * stride_k_d + j * stride_j_d + i * stride_i_d + nw * stride_nw_d] +
|
|
een_rescaled_e_deriv_e[m + l * stride_l_e + n * stride_n_e + i * stride_i_e + nw * stride_nw_e] *
|
|
een_rescaled_n[n + k * stride_k_n + j * stride_j_n + nw * stride_nw_n];
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#endif
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
#ifdef HAVE_OPENMP_OFFLOAD
|
|
qmckl_exit_code qmckl_compute_dtmp_c_omp_offload (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c );
|
|
#endif
|
|
#+end_src
|
|
|
|
**** cuBLAS offload :noexport:
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
#ifdef HAVE_CUBLAS_OFFLOAD
|
|
qmckl_exit_code
|
|
qmckl_compute_dtmp_c_cublas_offload (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c ) {
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num < 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
if (elec_num <= 0) {
|
|
return QMCKL_INVALID_ARG_3;
|
|
}
|
|
|
|
if (nucl_num <= 0) {
|
|
return QMCKL_INVALID_ARG_4;
|
|
}
|
|
|
|
if (walk_num <= 0) {
|
|
return QMCKL_INVALID_ARG_5;
|
|
}
|
|
|
|
qmckl_exit_code info = QMCKL_SUCCESS;
|
|
|
|
//cuBLAS initialization
|
|
cublasHandle_t handle;
|
|
if (cublasCreate(&handle) != CUBLAS_STATUS_SUCCESS)
|
|
{
|
|
fprintf(stdout, "CUBLAS initialization failed!\n");
|
|
exit(EXIT_FAILURE);
|
|
}
|
|
|
|
const double alpha = 1.0;
|
|
const double beta = 0.0;
|
|
|
|
const int64_t M = 4*elec_num;
|
|
const int64_t N = nucl_num*(cord_num + 1);
|
|
const int64_t K = elec_num;
|
|
|
|
const int64_t LDA = 4*elec_num;
|
|
const int64_t LDB = elec_num;
|
|
const int64_t LDC = 4*elec_num;
|
|
|
|
const int64_t af = elec_num*elec_num*4;
|
|
const int64_t bf = elec_num*nucl_num*(cord_num+1);
|
|
const int64_t cf = elec_num*4*nucl_num*(cord_num+1);
|
|
|
|
#pragma omp target enter data map(to:een_rescaled_e_deriv_e[0:elec_num*4*elec_num*(cord_num+1)*walk_num], een_rescaled_n[0:elec_num*nucl_num*(cord_num+1)*walk_num], dtmp_c[0:elec_num*4*nucl_num*(cord_num+1)*cord_num*walk_num])
|
|
#pragma omp target data use_device_ptr(een_rescaled_e_deriv_e, een_rescaled_n, dtmp_c)
|
|
{
|
|
for (int64_t nw=0; nw < walk_num; ++nw) {
|
|
int cublasError = cublasDgemmStridedBatched(handle, CUBLAS_OP_N, CUBLAS_OP_N, M, N, K, &alpha,
|
|
&(een_rescaled_e_deriv_e[(nw*(cord_num+1))]),
|
|
LDA, af,
|
|
&(een_rescaled_n[bf*nw]), LDB, 0,
|
|
&beta,
|
|
&(dtmp_c[(nw*cord_num)]),
|
|
LDC, cf, cord_num);
|
|
|
|
}
|
|
}
|
|
|
|
#pragma omp target exit data map(from:dtmp_c[0:cf*cord_num*walk_num])
|
|
|
|
cublasDestroy(handle);
|
|
return info;
|
|
}
|
|
#endif
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
#ifdef HAVE_CUBLAS_OFFLOAD
|
|
qmckl_exit_code qmckl_compute_dtmp_c_cublas_offload (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t walk_num,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n,
|
|
double* const dtmp_c );
|
|
#endif
|
|
#+end_src
|
|
|
|
*** Test
|
|
|
|
#+name: helper_funcs
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
elec_coord = np.array(elec_coord)[0]
|
|
nucl_coord = np.array(nucl_coord)
|
|
elnuc_dist = np.zeros(shape=(elec_num, nucl_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for a in range(nucl_num):
|
|
elnuc_dist[i, a] = np.linalg.norm(elec_coord[i] - nucl_coord[:,a])
|
|
|
|
kappa = 1.0
|
|
|
|
een_rescaled_n = np.zeros(shape=(nucl_num, elec_num, cord_num + 1), dtype=float)
|
|
een_rescaled_n[:,:,0] = 1.0
|
|
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
een_rescaled_n[a, i, 1] = np.exp(-kappa * elnuc_dist[i, a])
|
|
|
|
for l in range(2,cord_num+1):
|
|
for a in range(nucl_num):
|
|
for i in range(elec_num):
|
|
een_rescaled_n[a, i, l] = een_rescaled_n[a, i, l - 1] * een_rescaled_n[a, i, 1]
|
|
|
|
elec_dist = np.zeros(shape=(elec_num, elec_num),dtype=float)
|
|
for i in range(elec_num):
|
|
for j in range(elec_num):
|
|
elec_dist[i, j] = np.linalg.norm(elec_coord[i] - elec_coord[j])
|
|
|
|
kappa = 1.0
|
|
|
|
een_rescaled_e_ij = np.zeros(shape=(elec_num * (elec_num - 1)//2, cord_num+1), dtype=float)
|
|
een_rescaled_e_ij[:,0] = 1.0
|
|
|
|
k = 0
|
|
for j in range(elec_num):
|
|
for i in range(j):
|
|
een_rescaled_e_ij[k, 1] = np.exp(-kappa * elec_dist[i, j])
|
|
k = k + 1
|
|
|
|
for l in range(2, cord_num + 1):
|
|
for k in range(elec_num * (elec_num - 1)//2):
|
|
een_rescaled_e_ij[k, l] = een_rescaled_e_ij[k, l - 1] * een_rescaled_e_ij[k, 1]
|
|
|
|
een_rescaled_e = np.zeros(shape=(elec_num, elec_num, cord_num + 1), dtype=float)
|
|
een_rescaled_e[:,:,0] = 1.0
|
|
|
|
for l in range(1,cord_num+1):
|
|
k = 0
|
|
for j in range(elec_num):
|
|
for i in range(j):
|
|
x = een_rescaled_e_ij[k, l]
|
|
een_rescaled_e[i, j, l] = x
|
|
een_rescaled_e[j, i, l] = x
|
|
k = k + 1
|
|
|
|
for l in range(0,cord_num+1):
|
|
for j in range(0, elec_num):
|
|
een_rescaled_e[j,j,l] = 0.0
|
|
|
|
lkpm_of_cindex = np.array(lkpm_combined_index).T
|
|
#+end_src
|
|
|
|
#+RESULTS: helper_funcs
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
double tmp_c[walk_num][cord_num][cord_num+1][nucl_num][elec_num];
|
|
rc = qmckl_get_jastrow_tmp_c(context, &(tmp_c[0][0][0][0][0]));
|
|
|
|
double dtmp_c[walk_num][cord_num][cord_num+1][nucl_num][4][elec_num];
|
|
rc = qmckl_get_jastrow_dtmp_c(context, &(dtmp_c[0][0][0][0][0][0]));
|
|
|
|
printf("%e\n%e\n", tmp_c[0][0][1][0][0], 2.7083473948352403);
|
|
assert(fabs(tmp_c[0][0][1][0][0] - 2.7083473948352403) < 1e-12);
|
|
|
|
printf("%e\n%e\n", dtmp_c[0][1][0][0][0][0],0.237440520852232);
|
|
assert(fabs(dtmp_c[0][1][0][0][0][0] - 0.237440520852232) < 1e-12);
|
|
#+end_src
|
|
|
|
** Electron-electron-nucleus Jastrow \(f_{een}\)
|
|
|
|
Calculate the electron-electron-nuclear three-body jastrow component ~factor_een~
|
|
using the above prepared tables.
|
|
|
|
TODO: write equations.
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_een(qmckl_context context,
|
|
double* const factor_een,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_een(qmckl_context context,
|
|
double* const factor_een,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_factor_een(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walker.num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_een",
|
|
"Array too small. Expected walk_num");
|
|
}
|
|
memcpy(factor_een, ctx->jastrow.factor_een, sze*sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
**** Fortran interface
|
|
|
|
#+begin_src f90 :tangle (eval fh_func) :comments org
|
|
interface
|
|
integer(qmckl_exit_code) function qmckl_get_jastrow_factor_een (context, &
|
|
factor_een, size_max) bind(C)
|
|
use, intrinsic :: iso_c_binding
|
|
import
|
|
implicit none
|
|
integer (qmckl_context) , intent(in), value :: context
|
|
integer(c_int64_t), intent(in), value :: size_max
|
|
double precision, intent(out) :: factor_een(size_max)
|
|
end function qmckl_get_jastrow_factor_een
|
|
end interface
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_factor_een(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_factor_een(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if en rescaled distance is provided */
|
|
rc = qmckl_provide_een_rescaled_e(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_een_rescaled_n(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_jastrow_c_vector_full(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_lkpm_combined_index(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if tmp_c is provided */
|
|
rc = qmckl_provide_tmp_c(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_een_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.factor_een != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.factor_een);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_factor_een",
|
|
"Unable to free ctx->jastrow.factor_een");
|
|
}
|
|
ctx->jastrow.factor_een = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_een == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walker.num * sizeof(double);
|
|
double* factor_een = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (factor_een == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_factor_een",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_een = factor_een;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_een(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.dim_c_vector,
|
|
ctx->jastrow.c_vector_full,
|
|
ctx->jastrow.lkpm_combined_index,
|
|
ctx->jastrow.tmp_c,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.factor_een);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.factor_een_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute naive
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_een_naive
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_een_naive_args
|
|
| Variable | Type | In/Out | Description |
|
|
|-----------------------+----------------------------------------------------+--------+--------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~cord_num~ | ~int64_t~ | in | order of polynomials |
|
|
| ~dim_c_vector~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | in | combined indices |
|
|
| ~een_rescaled_e~ | ~double[walk_num][elec_num][elec_num][0:cord_num]~ | in | Electron-nucleus rescaled |
|
|
| ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor |
|
|
| ~factor_een~ | ~double[walk_num]~ | out | Electron-nucleus jastrow |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_een_naive_f( &
|
|
context, walk_num, elec_num, nucl_num, cord_num,&
|
|
dim_c_vector, c_vector_full, lkpm_combined_index, &
|
|
een_rescaled_e, een_rescaled_n, factor_een) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4)
|
|
double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector)
|
|
double precision , intent(in) :: een_rescaled_e(0:cord_num, elec_num, elec_num, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num)
|
|
double precision , intent(out) :: factor_een(walk_num)
|
|
|
|
integer*8 :: i, a, j, l, k, p, m, n, nw
|
|
double precision :: accu, accu2, cn
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
factor_een = 0.0d0
|
|
|
|
do nw =1, walk_num
|
|
do n = 1, dim_c_vector
|
|
l = lkpm_combined_index(n, 1)
|
|
k = lkpm_combined_index(n, 2)
|
|
p = lkpm_combined_index(n, 3)
|
|
m = lkpm_combined_index(n, 4)
|
|
|
|
do a = 1, nucl_num
|
|
accu2 = 0.0d0
|
|
cn = c_vector_full(a, n)
|
|
do j = 1, elec_num
|
|
accu = 0.0d0
|
|
do i = 1, elec_num
|
|
accu = accu + een_rescaled_e(k,i,j,nw) * &
|
|
een_rescaled_n(m,a,i,nw)
|
|
!if(nw .eq. 1) then
|
|
! print *,l,k,p,m,j,i,een_rescaled_e(k,i,j,nw), een_rescaled_n(m,a,i,nw), accu
|
|
!endif
|
|
end do
|
|
accu2 = accu2 + accu * een_rescaled_n(m + l,a,j,nw)
|
|
!print *, l,m,nw,accu, accu2, een_rescaled_n(m + l, a, j, nw), cn, factor_een(nw)
|
|
end do
|
|
factor_een(nw) = factor_een(nw) + accu2 * cn
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_een_naive_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_een_naive (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t cord_num,
|
|
const int64_t dim_c_vector,
|
|
const double* c_vector_full,
|
|
const int64_t* lkpm_combined_index,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const factor_een );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_een_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_een_naive &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
een_rescaled_e, &
|
|
een_rescaled_n, &
|
|
factor_een) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
integer (c_int64_t) , intent(in) , value :: dim_c_vector
|
|
real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4)
|
|
real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num)
|
|
real (c_double ) , intent(out) :: factor_een(walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_een_naive_f
|
|
info = qmckl_compute_factor_een_naive_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
een_rescaled_e, &
|
|
een_rescaled_n, &
|
|
factor_een)
|
|
|
|
end function qmckl_compute_factor_een_naive
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_een
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_een_args
|
|
| Variable | Type | In/Out | Description |
|
|
|-----------------------+------------------------------------------------------------------+---------------------------------+--------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~cord_num~ | ~int64_t~ | in | order of polynomials |
|
|
| ~dim_c_vector~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | in | combined indices |
|
|
| ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | vector of non-zero coefficients | |
|
|
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor |
|
|
| ~factor_een~ | ~double[walk_num]~ | out | Electron-nucleus jastrow |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_een_f( &
|
|
context, walk_num, elec_num, nucl_num, cord_num, &
|
|
dim_c_vector, c_vector_full, lkpm_combined_index, &
|
|
tmp_c, een_rescaled_n, factor_een) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4)
|
|
double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector)
|
|
double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
|
|
double precision , intent(out) :: factor_een(walk_num)
|
|
|
|
integer*8 :: i, a, j, l, k, p, m, n, nw
|
|
double precision :: accu, accu2, cn
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
factor_een = 0.0d0
|
|
|
|
do nw =1, walk_num
|
|
do n = 1, dim_c_vector
|
|
l = lkpm_combined_index(n, 1)
|
|
k = lkpm_combined_index(n, 2)
|
|
p = lkpm_combined_index(n, 3)
|
|
m = lkpm_combined_index(n, 4)
|
|
|
|
do a = 1, nucl_num
|
|
cn = c_vector_full(a, n)
|
|
if(cn == 0.d0) cycle
|
|
|
|
accu = 0.0d0
|
|
do j = 1, elec_num
|
|
accu = accu + een_rescaled_n(j,a,m,nw) * tmp_c(j,a,m+l,k,nw)
|
|
end do
|
|
factor_een(nw) = factor_een(nw) + accu * cn
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_een_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_een (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t cord_num,
|
|
const int64_t dim_c_vector,
|
|
const double* c_vector_full,
|
|
const int64_t* lkpm_combined_index,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
double* const factor_een );
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_een_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_een &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
een_rescaled_e, &
|
|
een_rescaled_n, &
|
|
factor_een) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
integer (c_int64_t) , intent(in) , value :: dim_c_vector
|
|
real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4)
|
|
real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(out) :: factor_een(walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_een_f
|
|
info = qmckl_compute_factor_een_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
een_rescaled_e, &
|
|
een_rescaled_n, &
|
|
factor_een)
|
|
|
|
end function qmckl_compute_factor_een
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
<<helper_funcs>>
|
|
|
|
kappa = 1.0
|
|
|
|
factor_een = 0.0
|
|
|
|
for n in range(0, dim_c_vector):
|
|
l = lkpm_of_cindex[0,n]
|
|
k = lkpm_of_cindex[1,n]
|
|
p = lkpm_of_cindex[2,n]
|
|
m = lkpm_of_cindex[3,n]
|
|
|
|
for a in range(0, nucl_num):
|
|
accu2 = 0.0
|
|
cn = c_vector_full[a][n]
|
|
for j in range(0, elec_num):
|
|
accu = 0.0
|
|
for i in range(0, elec_num):
|
|
accu = accu + een_rescaled_e[i,j,k] * \
|
|
een_rescaled_n[a,i,m]
|
|
accu2 = accu2 + accu * een_rescaled_n[a,j,m+l]
|
|
factor_een = factor_een + accu2 * cn
|
|
|
|
print("factor_een:",factor_een)
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: factor_een: -0.37407972141304213
|
|
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
/* Check if Jastrow is properly initialized */
|
|
assert(qmckl_jastrow_provided(context));
|
|
|
|
double factor_een[walk_num];
|
|
rc = qmckl_get_jastrow_factor_een(context, &(factor_een[0]),walk_num);
|
|
|
|
assert(fabs(factor_een[0] + 0.37407972141304213) < 1e-12);
|
|
#+end_src
|
|
|
|
** Electron-electron-nucleus Jastrow \(f_{een}\) derivative
|
|
|
|
Calculate the electron-electron-nuclear three-body jastrow component ~factor_een_deriv_e~
|
|
using the above prepared tables.
|
|
|
|
TODO: write equations.
|
|
|
|
*** Get
|
|
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context,
|
|
double* const factor_een_deriv_e,
|
|
const int64_t size_max);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_factor_een_deriv_e(qmckl_context context,
|
|
double* const factor_een_deriv_e,
|
|
const int64_t size_max)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_factor_een_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walker.num * 4 * ctx->electron.num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_een_deriv_e",
|
|
"Array too small. Expected 4*walk_num*elec_num");
|
|
}
|
|
memcpy(factor_een_deriv_e, ctx->jastrow.factor_een_deriv_e, sze*sizeof(double));
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_factor_een_deriv_e(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_factor_een_deriv_e(qmckl_context context)
|
|
{
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if en rescaled distance is provided */
|
|
rc = qmckl_provide_een_rescaled_e(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_een_rescaled_n(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance is provided */
|
|
rc = qmckl_provide_een_rescaled_e_deriv_e(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_een_rescaled_n_deriv_e(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_jastrow_c_vector_full(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if en rescaled distance derivatives is provided */
|
|
rc = qmckl_provide_lkpm_combined_index(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if tmp_c is provided */
|
|
rc = qmckl_provide_tmp_c(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Check if dtmp_c is provided */
|
|
rc = qmckl_provide_dtmp_c(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_een_deriv_e_date) {
|
|
|
|
if (ctx->electron.walker.num > ctx->electron.walker_old.num) {
|
|
if (ctx->jastrow.factor_een_deriv_e != NULL) {
|
|
rc = qmckl_free(context, ctx->jastrow.factor_een_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_provide_factor_een_deriv_e",
|
|
"Unable to free ctx->jastrow.factor_een_deriv_e");
|
|
}
|
|
ctx->jastrow.factor_een_deriv_e = NULL;
|
|
}
|
|
}
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_een_deriv_e == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = 4 * ctx->electron.num * ctx->electron.walker.num * sizeof(double);
|
|
double* factor_een_deriv_e = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (factor_een_deriv_e == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_factor_een_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_een_deriv_e = factor_een_deriv_e;
|
|
}
|
|
|
|
rc = qmckl_compute_factor_een_deriv_e(context,
|
|
ctx->electron.walker.num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.dim_c_vector,
|
|
ctx->jastrow.c_vector_full,
|
|
ctx->jastrow.lkpm_combined_index,
|
|
ctx->jastrow.tmp_c,
|
|
ctx->jastrow.dtmp_c,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.een_rescaled_n_deriv_e,
|
|
ctx->jastrow.factor_een_deriv_e);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.factor_een_deriv_e_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
*** Compute Naive
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_een_deriv_e_naive
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_een_deriv_e_naive_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------+-------------------------------------------------------+--------+--------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~cord_num~ | ~int64_t~ | in | order of polynomials |
|
|
| ~dim_c_vector~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | in | combined indices |
|
|
| ~een_rescaled_e~ | ~double[walk_num][elec_num][elec_num][0:cord_num]~ | in | Electron-nucleus rescaled |
|
|
| ~een_rescaled_n~ | ~double[walk_num][elec_num][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor |
|
|
| ~een_rescaled_e_deriv_e~ | ~double[walk_num][elec_num][4][elec_num][0:cord_num]~ | in | Electron-nucleus rescaled |
|
|
| ~een_rescaled_n_deriv_e~ | ~double[walk_num][elec_num][4][nucl_num][0:cord_num]~ | in | Electron-nucleus rescaled factor |
|
|
| ~factor_een_deriv_e~ | ~double[walk_num][4][elec_num]~ | out | Electron-nucleus jastrow |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_een_deriv_e_naive_f( &
|
|
context, walk_num, elec_num, nucl_num, cord_num, dim_c_vector, &
|
|
c_vector_full, lkpm_combined_index, een_rescaled_e, een_rescaled_n, &
|
|
een_rescaled_e_deriv_e, een_rescaled_n_deriv_e, factor_een_deriv_e)&
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector, 4)
|
|
double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector)
|
|
double precision , intent(in) :: een_rescaled_e(0:cord_num, elec_num, elec_num, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n(0:cord_num, nucl_num, elec_num, walk_num)
|
|
double precision , intent(in) :: een_rescaled_e_deriv_e(0:cord_num, elec_num, 4, elec_num, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n_deriv_e(0:cord_num, nucl_num, 4, elec_num, walk_num)
|
|
double precision , intent(out) :: factor_een_deriv_e(elec_num, 4, walk_num)
|
|
|
|
integer*8 :: i, a, j, l, k, p, m, n, nw
|
|
double precision :: accu, accu2, cn
|
|
double precision :: daccu(1:4), daccu2(1:4)
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
factor_een_deriv_e = 0.0d0
|
|
|
|
do nw =1, walk_num
|
|
do n = 1, dim_c_vector
|
|
l = lkpm_combined_index(n, 1)
|
|
k = lkpm_combined_index(n, 2)
|
|
p = lkpm_combined_index(n, 3)
|
|
m = lkpm_combined_index(n, 4)
|
|
|
|
do a = 1, nucl_num
|
|
cn = c_vector_full(a, n)
|
|
do j = 1, elec_num
|
|
accu = 0.0d0
|
|
accu2 = 0.0d0
|
|
daccu = 0.0d0
|
|
daccu2 = 0.0d0
|
|
do i = 1, elec_num
|
|
accu = accu + een_rescaled_e(k, i, j, nw) * &
|
|
een_rescaled_n(m, a, i, nw)
|
|
accu2 = accu2 + een_rescaled_e(k, i, j, nw) * &
|
|
een_rescaled_n(m + l, a, i, nw)
|
|
daccu(1:4) = daccu(1:4) + een_rescaled_e_deriv_e(k, j, 1:4, i, nw) * &
|
|
een_rescaled_n(m, a, i, nw)
|
|
daccu2(1:4) = daccu2(1:4) + een_rescaled_e_deriv_e(k, j, 1:4, i, nw) * &
|
|
een_rescaled_n(m + l, a, i, nw)
|
|
end do
|
|
factor_een_deriv_e(j, 1:4, nw) = factor_een_deriv_e(j, 1:4, nw) + &
|
|
(accu * een_rescaled_n_deriv_e(m + l, a, 1:4, j, nw) &
|
|
+ daccu(1:4) * een_rescaled_n(m + l, a, j, nw) &
|
|
+ daccu2(1:4) * een_rescaled_n(m, a, j, nw) &
|
|
+ accu2 * een_rescaled_n_deriv_e(m, a, 1:4, j, nw)) * cn
|
|
|
|
factor_een_deriv_e(j, 4, nw) = factor_een_deriv_e(j, 4, nw) + 2.0d0 * ( &
|
|
daccu (1) * een_rescaled_n_deriv_e(m + l, a, 1, j, nw) + &
|
|
daccu (2) * een_rescaled_n_deriv_e(m + l, a, 2, j, nw) + &
|
|
daccu (3) * een_rescaled_n_deriv_e(m + l, a, 3, j, nw) + &
|
|
daccu2(1) * een_rescaled_n_deriv_e(m, a, 1, j, nw ) + &
|
|
daccu2(2) * een_rescaled_n_deriv_e(m, a, 2, j, nw ) + &
|
|
daccu2(3) * een_rescaled_n_deriv_e(m, a, 3, j, nw ) ) * cn
|
|
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_een_deriv_e_naive_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_deriv_e_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_een_deriv_e_naive (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t cord_num,
|
|
const int64_t dim_c_vector,
|
|
const double* c_vector_full,
|
|
const int64_t* lkpm_combined_index,
|
|
const double* een_rescaled_e,
|
|
const double* een_rescaled_n,
|
|
const double* een_rescaled_e_deriv_e,
|
|
const double* een_rescaled_n_deriv_e,
|
|
double* const factor_een_deriv_e );
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_een_deriv_e_naive_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_een_deriv_e_naive &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
een_rescaled_e, &
|
|
een_rescaled_n, &
|
|
een_rescaled_e_deriv_e, &
|
|
een_rescaled_n_deriv_e, &
|
|
factor_een_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
integer (c_int64_t) , intent(in) , value :: dim_c_vector
|
|
real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4)
|
|
real (c_double ) , intent(in) :: een_rescaled_e(0:cord_num,elec_num,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n(0:cord_num,nucl_num,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_e_deriv_e(0:cord_num,elec_num,4,elec_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n_deriv_e(0:cord_num,nucl_num,4,elec_num,walk_num)
|
|
real (c_double ) , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_een_deriv_e_naive_f
|
|
info = qmckl_compute_factor_een_deriv_e_naive_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
een_rescaled_e, &
|
|
een_rescaled_n, &
|
|
een_rescaled_e_deriv_e, &
|
|
een_rescaled_n_deriv_e, &
|
|
factor_een_deriv_e)
|
|
|
|
end function qmckl_compute_factor_een_deriv_e_naive
|
|
#+end_src
|
|
|
|
*** Compute
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_factor_een_deriv_e
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_een_deriv_e_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------------+---------------------------------------------------------------------+--------+------------------------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~walk_num~ | ~int64_t~ | in | Number of walkers |
|
|
| ~elec_num~ | ~int64_t~ | in | Number of electrons |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of nucleii |
|
|
| ~cord_num~ | ~int64_t~ | in | order of polynomials |
|
|
| ~dim_c_vector~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~c_vector_full~ | ~double[dim_c_vector][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_c_vector]~ | in | combined indices |
|
|
| ~tmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][elec_num]~ | in | Temporary intermediate tensor |
|
|
| ~dtmp_c~ | ~double[walk_num][0:cord_num-1][0:cord_num][nucl_num][4][elec_num]~ | in | vector of non-zero coefficients |
|
|
| ~een_rescaled_n~ | ~double[walk_num][0:cord_num][nucl_num][elec_num]~ | in | Electron-nucleus rescaled factor |
|
|
| ~een_rescaled_n_deriv_e~ | ~double[walk_num][0:cord_num][nucl_num][4][elec_num]~ | in | Derivative of Electron-nucleus rescaled factor |
|
|
| ~factor_een_deriv_e~ | ~double[walk_num][4][elec_num]~ | out | Derivative of Electron-nucleus jastrow |
|
|
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_factor_een_deriv_e_f( &
|
|
context, walk_num, elec_num, nucl_num, &
|
|
cord_num, dim_c_vector, c_vector_full, lkpm_combined_index, &
|
|
tmp_c, dtmp_c, een_rescaled_n, een_rescaled_n_deriv_e, factor_een_deriv_e)&
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: walk_num, elec_num, cord_num, nucl_num, dim_c_vector
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_c_vector,4)
|
|
double precision , intent(in) :: c_vector_full(nucl_num, dim_c_vector)
|
|
double precision , intent(in) :: tmp_c(elec_num, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
|
|
double precision , intent(in) :: dtmp_c(elec_num, 4, nucl_num,0:cord_num, 0:cord_num-1, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n(elec_num, nucl_num, 0:cord_num, walk_num)
|
|
double precision , intent(in) :: een_rescaled_n_deriv_e(elec_num, 4, nucl_num, 0:cord_num, walk_num)
|
|
double precision , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer*8 :: i, a, j, l, k, p, m, n, nw, ii
|
|
double precision :: accu, accu2, cn
|
|
|
|
info = QMCKL_SUCCESS
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) then
|
|
info = QMCKL_INVALID_CONTEXT
|
|
return
|
|
endif
|
|
|
|
if (walk_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_2
|
|
return
|
|
endif
|
|
|
|
if (elec_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_3
|
|
return
|
|
endif
|
|
|
|
if (nucl_num <= 0) then
|
|
info = QMCKL_INVALID_ARG_4
|
|
return
|
|
endif
|
|
|
|
if (cord_num < 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
factor_een_deriv_e = 0.0d0
|
|
|
|
do nw =1, walk_num
|
|
do n = 1, dim_c_vector
|
|
l = lkpm_combined_index(n, 1)
|
|
k = lkpm_combined_index(n, 2)
|
|
p = lkpm_combined_index(n, 3)
|
|
m = lkpm_combined_index(n, 4)
|
|
|
|
do a = 1, nucl_num
|
|
cn = c_vector_full(a, n)
|
|
if(cn == 0.d0) cycle
|
|
|
|
do ii = 1, 4
|
|
do j = 1, elec_num
|
|
factor_een_deriv_e(j,ii,nw) = factor_een_deriv_e(j,ii,nw) + (&
|
|
tmp_c(j,a,m,k,nw) * een_rescaled_n_deriv_e(j,ii,a,m+l,nw) + &
|
|
(dtmp_c(j,ii,a,m,k,nw)) * een_rescaled_n(j,a,m+l,nw) + &
|
|
(dtmp_c(j,ii,a,m+l,k,nw)) * een_rescaled_n(j,a,m ,nw) + &
|
|
tmp_c(j,a,m+l,k,nw) * een_rescaled_n_deriv_e(j,ii,a,m,nw) &
|
|
) * cn
|
|
end do
|
|
end do
|
|
|
|
cn = cn + cn
|
|
do j = 1, elec_num
|
|
factor_een_deriv_e(j,4,nw) = factor_een_deriv_e(j,4,nw) + (&
|
|
(dtmp_c(j,1,a,m ,k,nw)) * een_rescaled_n_deriv_e(j,1,a,m+l,nw) + &
|
|
(dtmp_c(j,2,a,m ,k,nw)) * een_rescaled_n_deriv_e(j,2,a,m+l,nw) + &
|
|
(dtmp_c(j,3,a,m ,k,nw)) * een_rescaled_n_deriv_e(j,3,a,m+l,nw) + &
|
|
(dtmp_c(j,1,a,m+l,k,nw)) * een_rescaled_n_deriv_e(j,1,a,m ,nw) + &
|
|
(dtmp_c(j,2,a,m+l,k,nw)) * een_rescaled_n_deriv_e(j,2,a,m ,nw) + &
|
|
(dtmp_c(j,3,a,m+l,k,nw)) * een_rescaled_n_deriv_e(j,3,a,m ,nw) &
|
|
) * cn
|
|
end do
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_een_deriv_e_f
|
|
#+end_src
|
|
|
|
# #+CALL: generate_c_header(table=qmckl_factor_een_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_compute_factor_een_deriv_e (
|
|
const qmckl_context context,
|
|
const int64_t walk_num,
|
|
const int64_t elec_num,
|
|
const int64_t nucl_num,
|
|
const int64_t cord_num,
|
|
const int64_t dim_c_vector,
|
|
const double* c_vector_full,
|
|
const int64_t* lkpm_combined_index,
|
|
const double* tmp_c,
|
|
const double* dtmp_c,
|
|
const double* een_rescaled_n,
|
|
const double* een_rescaled_n_deriv_e,
|
|
double* const factor_een_deriv_e );
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_een_deriv_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_factor_een_deriv_e &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
tmp_c, &
|
|
dtmp_c, &
|
|
een_rescaled_n, &
|
|
een_rescaled_n_deriv_e, &
|
|
factor_een_deriv_e) &
|
|
bind(C) result(info)
|
|
|
|
use, intrinsic :: iso_c_binding
|
|
implicit none
|
|
|
|
integer (c_int64_t) , intent(in) , value :: context
|
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
integer (c_int64_t) , intent(in) , value :: cord_num
|
|
integer (c_int64_t) , intent(in) , value :: dim_c_vector
|
|
real (c_double ) , intent(in) :: c_vector_full(nucl_num,dim_c_vector)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_c_vector,4)
|
|
real (c_double ) , intent(in) :: tmp_c(elec_num,nucl_num,0:cord_num,0:cord_num-1,walk_num)
|
|
real (c_double ) , intent(in) :: dtmp_c(elec_num,4,nucl_num,0:cord_num,0:cord_num-1,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n(elec_num,nucl_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(in) :: een_rescaled_n_deriv_e(elec_num,4,nucl_num,0:cord_num,walk_num)
|
|
real (c_double ) , intent(out) :: factor_een_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_factor_een_deriv_e_f
|
|
info = qmckl_compute_factor_een_deriv_e_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
nucl_num, &
|
|
cord_num, &
|
|
dim_c_vector, &
|
|
c_vector_full, &
|
|
lkpm_combined_index, &
|
|
tmp_c, &
|
|
dtmp_c, &
|
|
een_rescaled_n, &
|
|
een_rescaled_n_deriv_e, &
|
|
factor_een_deriv_e)
|
|
|
|
end function qmckl_compute_factor_een_deriv_e
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
<<een_e_deriv_e>>
|
|
|
|
<<helper_funcs>>
|
|
|
|
kappa = 1.0
|
|
|
|
factor_een = 0.0
|
|
|
|
daccu = np.zeros(4, dtype=float)
|
|
daccu2 = np.zeros(4, dtype=float)
|
|
een_rescaled_e_deriv_e_t = een_rescaled_e_deriv_e.T
|
|
print(een_rescaled_e_deriv_e_t.shape)
|
|
for n in range(0, dim_c_vector):
|
|
l = lkpm_of_cindex[0,n]
|
|
k = lkpm_of_cindex[1,n]
|
|
p = lkpm_of_cindex[2,n]
|
|
m = lkpm_of_cindex[3,n]
|
|
|
|
for a in range(0, nucl_num):
|
|
cn = c_vector_full[a][n]
|
|
for j in range(0, elec_num):
|
|
accu = 0.0
|
|
accu2 = 0.0
|
|
daccu = 0.0
|
|
daccu2 = 0.0
|
|
for i in range(0, elec_num):
|
|
accu = accu + een_rescaled_e[i,j,k] * \
|
|
een_rescaled_n[a,i,m]
|
|
accu2 = accu2 + een_rescaled_e[i,j,k] * \
|
|
een_rescaled_n[a,i,m+l]
|
|
# daccu[0:4] = daccu[0:4] + een_rescaled_e_deriv_e_t[k,j,0:4,i,k] * \
|
|
# een_rescaled_n[a,i,m]
|
|
# daccu[0:4] = daccu[0:4] + een_rescaled_e_deriv_e_t[k,j,0:4,i,k] * \
|
|
# een_rescaled_n[a,i,m]
|
|
accu2 = accu2 + accu * een_rescaled_n[a,j,m+l]
|
|
# factor_een = factor_een + accu2 * cn
|
|
|
|
print("factor_een:",factor_een)
|
|
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: (6, 10, 4, 10)
|
|
: factor_een: 0.0
|
|
|
|
|
|
#+begin_src c :tangle (eval c_test)
|
|
/* Check if Jastrow is properly initialized */
|
|
assert(qmckl_jastrow_provided(context));
|
|
|
|
double factor_een_deriv_e[4][walk_num][elec_num];
|
|
rc = qmckl_get_jastrow_factor_een_deriv_e(context, &(factor_een_deriv_e[0][0][0]),4*walk_num*elec_num);
|
|
|
|
assert(fabs(factor_een_deriv_e[0][0][0] + 0.0005481671107226865) < 1e-12);
|
|
#+end_src
|
|
|
|
|
|
** TODO Jastrow VGL functions
|
|
|
|
* End of files :noexport:
|
|
|
|
#+begin_src c :tangle (eval h_private_type)
|
|
#endif
|
|
#+end_src
|
|
|
|
#+begin_src c :tangle (eval h_private_func)
|
|
#endif
|
|
#+end_src
|
|
|
|
*** Test
|
|
#+begin_src c :tangle (eval c_test)
|
|
rc = qmckl_context_destroy(context);
|
|
assert (rc == QMCKL_SUCCESS);
|
|
|
|
return 0;
|
|
}
|
|
#+end_src
|
|
|
|
|
|
# -*- mode: org -*-
|
|
# vim: syntax=c
|
|
|
|
|
|
|