mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-08-19 03:41:44 +02:00
6944 lines
248 KiB
Org Mode
6944 lines
248 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 us 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_{i=1}^{N_\text{elec}} \sum_{\alpha=1}^{N_\text{nucl}}
|
|
\frac{a_1\, f(R_{i\alpha})}{1+a_2\, f(R_{i\alpha})} +
|
|
\sum_{p=2}^{N_\text{ord}^a} a_{p+1}\, [f(R_{i\alpha})]^p - J_{eN}^\infty
|
|
\]
|
|
|
|
$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[ g({r}_{ij}) \right]^k
|
|
\left[ \left[ g({R}_{i\alpha}) \right]^l + \left[ g({R}_{j\alpha}) \right]^l \right]
|
|
\left[ g({R}_{i\,\alpha}) \, g({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(r) = e^{-\kappa\, 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"
|
|
#+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 |
|
|
| ~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 Nucleii types |
|
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of types of Nucleii |
|
|
| ~aord_vector~ | ~double[aord_num + 1][type_nucl_num]~ | in | Order of a polynomial coefficients |
|
|
| ~bord_vector~ | ~double[bord_num + 1]~ | in | Order of b polynomial coefficients |
|
|
| ~cord_vector~ | ~double[cord_num][type_nucl_num]~ | in | Order of c polynomial coefficients |
|
|
| ~factor_ee~ | ~double[walk_num]~ | out | Jastrow factor: electron-electron part |
|
|
| ~factor_ee_date~ | ~uint64_t~ | out | Jastrow factor: electron-electron part |
|
|
| ~factor_en~ | ~double[walk_num]~ | out | Jastrow factor: electron-nucleus part |
|
|
| ~factor_en_date~ | ~uint64_t~ | out | Jastrow factor: electron-nucleus part |
|
|
| ~factor_een~ | ~double[walk_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][walk_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][walk_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][walk_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_cord_vect~ | ~int64_t~ | Number of unique C coefficients |
|
|
| ~dim_cord_vect_date~ | ~uint64_t~ | Number of unique C coefficients |
|
|
| ~asymp_jasb~ | ~double[2]~ | Asymptotic component |
|
|
| ~asymp_jasb_date~ | ~uint64_t~ | Asymptotic component |
|
|
| ~cord_vect_full~ | ~double[dim_cord_vect][nucl_num]~ | vector of non-zero coefficients |
|
|
| ~cord_vect_full_date~ | ~uint64_t~ | Keep track of changes here |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | 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[walk_num][cord_num][cord_num+1][nucl_num][elec_num]~ | vector of non-zero coefficients |
|
|
| ~dtmp_c~ | ~double[walk_num][elec_num][4][nucl_num][cord_num+1][cord_num]~ | vector of non-zero coefficients |
|
|
|
|
| ~een_rescaled_n~ | ~double[walk_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[walk_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[walk_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 = [[[-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 = [
|
|
[ 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]
|
|
|
|
type_nucl_num = 1
|
|
aord_num = 5
|
|
bord_num = 5
|
|
cord_num = 5
|
|
dim_cord_vect= 23
|
|
type_nucl_vector = [ 1, 1]
|
|
aord_vector = [
|
|
[0.000000000000000E+000],
|
|
[0.000000000000000E+000],
|
|
[-0.380512000000000E+000],
|
|
[-0.157996000000000E+000],
|
|
[-3.155800000000000E-002],
|
|
[2.151200000000000E-002]]
|
|
|
|
bord_vector = [ 0.500000000000000E-000, 0.153660000000000E-000, 6.722620000000000E-002,
|
|
2.157000000000000E-002, 7.309600000000000E-003, 2.866000000000000E-003]
|
|
cord_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 ]
|
|
cord_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_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;
|
|
int64_t* type_nucl_vector;
|
|
double * aord_vector;
|
|
double * bord_vector;
|
|
double * cord_vector;
|
|
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_cord_vect;
|
|
uint64_t dim_cord_vect_date;
|
|
double * cord_vect_full;
|
|
uint64_t cord_vect_full_date;
|
|
int64_t* lkpm_combined_index;
|
|
uint64_t lkpm_combined_index_date;
|
|
double * tmp_c;
|
|
double * dtmp_c;
|
|
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;
|
|
} 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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
ctx->jastrow.uninitialized = (1 << 5) - 1;
|
|
|
|
/* Default values */
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+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_aord_vector (qmckl_context context, double * const aord_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_get_jastrow_bord_vector (qmckl_context context, double * const bord_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_get_jastrow_cord_vector (qmckl_context context, double * const cord_vector, 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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
return ctx->jastrow.provided;
|
|
}
|
|
#+end_src
|
|
|
|
#+NAME:post
|
|
#+begin_src c :exports none
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return NULL;
|
|
}
|
|
#+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* const) 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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 0;
|
|
|
|
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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 0;
|
|
|
|
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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 1;
|
|
|
|
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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 2;
|
|
|
|
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_aord_vector (const qmckl_context context,
|
|
double * const aord_vector,
|
|
const int64_t size_max) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (aord_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_aord_vector",
|
|
"aord_vector is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 3;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.aord_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_aord_vector",
|
|
"Array too small. Expected (ctx->jastrow.aord_num + 1)*ctx->jastrow.type_nucl_num");
|
|
}
|
|
memcpy(aord_vector, ctx->jastrow.aord_vector, sze*sizeof(double));
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_bord_vector (const qmckl_context context,
|
|
double * const bord_vector,
|
|
const int64_t size_max) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (bord_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_bord_vector",
|
|
"bord_vector is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 4;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.bord_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_bord_vector",
|
|
"Array too small. Expected (ctx->jastrow.bord_num + 1)");
|
|
}
|
|
memcpy(bord_vector, ctx->jastrow.bord_vector, sze*sizeof(double));
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code
|
|
qmckl_get_jastrow_cord_vector (const qmckl_context context,
|
|
double * const cord_vector,
|
|
const int64_t size_max) {
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return (char) 0;
|
|
}
|
|
|
|
if (cord_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_get_jastrow_cord_vector",
|
|
"cord_vector is a null pointer");
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int32_t mask = 1 << 5;
|
|
|
|
if ( (ctx->jastrow.uninitialized & mask) != 0) {
|
|
return QMCKL_NOT_PROVIDED;
|
|
}
|
|
|
|
assert (ctx->jastrow.cord_vector != NULL);
|
|
|
|
int64_t dim_cord_vect;
|
|
qmckl_exit_code rc = qmckl_get_jastrow_dim_cord_vect(context, &dim_cord_vect);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
int64_t sze=dim_cord_vect * ctx->jastrow.type_nucl_num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_cord_vector",
|
|
"Array too small. Expected dim_cord_vect * jastrow.type_nucl_num");
|
|
}
|
|
memcpy(cord_vector, ctx->jastrow.cord_vector, sze*sizeof(double));
|
|
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_ord_num (qmckl_context context, const int64_t aord_num, const int64_t bord_num, 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_aord_vector (qmckl_context context, const double * aord_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_set_jastrow_bord_vector (qmckl_context context, const double * bord_vector, const int64_t size_max);
|
|
qmckl_exit_code qmckl_set_jastrow_cord_vector (qmckl_context context, const double * cord_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* const) context;
|
|
#+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_ord_num(qmckl_context context,
|
|
const int64_t aord_num,
|
|
const int64_t bord_num,
|
|
const int64_t cord_num)
|
|
{
|
|
<<pre2>>
|
|
|
|
if (aord_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_ord_num",
|
|
"aord_num <= 0");
|
|
}
|
|
|
|
if (bord_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_ord_num",
|
|
"bord_num <= 0");
|
|
}
|
|
|
|
if (cord_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_ord_num",
|
|
"cord_num <= 0");
|
|
}
|
|
|
|
int32_t mask = 1 << 0;
|
|
ctx->jastrow.aord_num = aord_num;
|
|
ctx->jastrow.bord_num = bord_num;
|
|
ctx->jastrow.cord_num = cord_num;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_type_nucl_num(qmckl_context context, const int64_t type_nucl_num)
|
|
{
|
|
<<pre2>>
|
|
|
|
if (type_nucl_num <= 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_type_nucl_num",
|
|
"type_nucl_num < 0");
|
|
}
|
|
|
|
int32_t mask = 1 << 1;
|
|
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)
|
|
{
|
|
<<pre2>>
|
|
|
|
int32_t mask = 1 << 2;
|
|
|
|
int64_t type_nucl_num;
|
|
qmckl_exit_code rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
if (type_nucl_num == 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_FAILURE,
|
|
"qmckl_set_jastrow_type_nucl_vector",
|
|
"type_nucl_num is not set");
|
|
}
|
|
|
|
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",
|
|
NULL);
|
|
}
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = nucl_num * sizeof(int64_t);
|
|
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
|
|
|
|
if(new_array == NULL) {
|
|
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_aord_vector(qmckl_context context,
|
|
double const * aord_vector,
|
|
const int64_t size_max)
|
|
{
|
|
<<pre2>>
|
|
|
|
int32_t mask = 1 << 3;
|
|
|
|
int64_t aord_num;
|
|
qmckl_exit_code rc = qmckl_get_jastrow_aord_num(context, &aord_num);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
int64_t type_nucl_num;
|
|
rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
if (aord_num == 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_FAILURE,
|
|
"qmckl_set_jastrow_coefficient",
|
|
"aord_num is not set");
|
|
}
|
|
|
|
if (aord_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_aord_vector",
|
|
"aord_vector = NULL");
|
|
}
|
|
|
|
if (ctx->jastrow.aord_vector != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.aord_vector);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_set_ord_vector",
|
|
NULL);
|
|
}
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = (aord_num + 1) * 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_aord_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, aord_vector, mem_info.size);
|
|
|
|
ctx->jastrow.aord_vector = new_array;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_bord_vector(qmckl_context context,
|
|
double const * bord_vector,
|
|
const int64_t size_max)
|
|
{
|
|
<<pre2>>
|
|
|
|
int32_t mask = 1 << 4;
|
|
|
|
int64_t bord_num;
|
|
qmckl_exit_code rc = qmckl_get_jastrow_bord_num(context, &bord_num);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
if (bord_num == 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_FAILURE,
|
|
"qmckl_set_jastrow_coefficient",
|
|
"bord_num is not set");
|
|
}
|
|
|
|
if (bord_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_bord_vector",
|
|
"bord_vector = NULL");
|
|
}
|
|
|
|
if (ctx->jastrow.bord_vector != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.bord_vector);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_set_ord_vector",
|
|
NULL);
|
|
}
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = (bord_num + 1) * sizeof(double);
|
|
|
|
if ((size_t) size_max < mem_info.size/sizeof(double)) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_set_jastrow_bord_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, bord_vector, mem_info.size);
|
|
|
|
ctx->jastrow.bord_vector = new_array;
|
|
|
|
<<post2>>
|
|
}
|
|
|
|
|
|
qmckl_exit_code
|
|
qmckl_set_jastrow_cord_vector(qmckl_context context,
|
|
double const * cord_vector,
|
|
const int64_t size_max)
|
|
{
|
|
<<pre2>>
|
|
|
|
int32_t mask = 1 << 5;
|
|
|
|
qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
int64_t dim_cord_vect;
|
|
rc = qmckl_get_jastrow_dim_cord_vect(context, &dim_cord_vect);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
int64_t type_nucl_num;
|
|
rc = qmckl_get_jastrow_type_nucl_num(context, &type_nucl_num);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
if (dim_cord_vect == 0) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_FAILURE,
|
|
"qmckl_set_jastrow_coefficient",
|
|
"dim_cord_vect is not set");
|
|
}
|
|
|
|
if (cord_vector == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_2,
|
|
"qmckl_set_jastrow_cord_vector",
|
|
"cord_vector = NULL");
|
|
}
|
|
|
|
if (ctx->jastrow.cord_vector != NULL) {
|
|
qmckl_exit_code rc = qmckl_free(context, ctx->jastrow.cord_vector);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return qmckl_failwith( context, rc,
|
|
"qmckl_set_ord_vector",
|
|
NULL);
|
|
}
|
|
}
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = dim_cord_vect * 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_cord_vector",
|
|
"Array too small. Expected dim_cord_vect * 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, cord_vector, mem_info.size);
|
|
|
|
ctx->jastrow.cord_vector = new_array;
|
|
|
|
<<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* const) 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);
|
|
}
|
|
|
|
qmckl_exit_code rc = QMCKL_SUCCESS;
|
|
return rc;
|
|
|
|
|
|
}
|
|
#+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;
|
|
double rescale_factor_kappa_ee = 1.0;
|
|
double rescale_factor_kappa_en = 1.0;
|
|
double nucl_rescale_factor_kappa = 1.0;
|
|
double* elec_coord = &(n2_elec_coord[0][0][0]);
|
|
|
|
const double* nucl_charge = n2_charge;
|
|
int64_t nucl_num = n2_nucl_num;
|
|
double* nucl_coord = &(n2_nucl_coord[0][0]);
|
|
int64_t size_max;
|
|
|
|
/* Provide Electron data */
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
assert(!qmckl_electron_provided(context));
|
|
|
|
int64_t n;
|
|
rc = qmckl_get_electron_num (context, &n);
|
|
assert(rc == QMCKL_NOT_PROVIDED);
|
|
|
|
rc = qmckl_get_electron_up_num (context, &n);
|
|
assert(rc == QMCKL_NOT_PROVIDED);
|
|
|
|
rc = qmckl_get_electron_down_num (context, &n);
|
|
assert(rc == QMCKL_NOT_PROVIDED);
|
|
|
|
|
|
rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(!qmckl_electron_provided(context));
|
|
|
|
rc = qmckl_get_electron_up_num (context, &n);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(n == elec_up_num);
|
|
|
|
rc = qmckl_get_electron_down_num (context, &n);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(n == elec_dn_num);
|
|
|
|
rc = qmckl_get_electron_num (context, &n);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(n == elec_num);
|
|
|
|
double k_ee = 0.;
|
|
double k_en = 0.;
|
|
rc = qmckl_get_electron_rescale_factor_ee (context, &k_ee);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(k_ee == 1.0);
|
|
|
|
rc = qmckl_get_electron_rescale_factor_en (context, &k_en);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(k_en == 1.0);
|
|
|
|
rc = qmckl_set_electron_rescale_factor_en(context, rescale_factor_kappa_en);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_set_electron_rescale_factor_ee(context, rescale_factor_kappa_ee);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_get_electron_rescale_factor_ee (context, &k_ee);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(k_ee == rescale_factor_kappa_ee);
|
|
|
|
rc = qmckl_get_electron_rescale_factor_en (context, &k_en);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(k_en == rescale_factor_kappa_en);
|
|
|
|
|
|
int64_t w;
|
|
rc = qmckl_get_electron_walk_num (context, &w);
|
|
assert(rc == QMCKL_NOT_PROVIDED);
|
|
|
|
|
|
rc = qmckl_set_electron_walk_num (context, walk_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_get_electron_walk_num (context, &w);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(w == walk_num);
|
|
|
|
assert(qmckl_electron_provided(context));
|
|
|
|
rc = qmckl_set_electron_coord (context, 'N', elec_coord, walk_num*3*elec_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
double elec_coord2[walk_num*3*elec_num];
|
|
|
|
rc = 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_get_nucleus_num (context, &n);
|
|
assert(rc == QMCKL_NOT_PROVIDED);
|
|
|
|
|
|
rc = qmckl_set_nucleus_num (context, nucl_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(!qmckl_nucleus_provided(context));
|
|
|
|
rc = qmckl_get_nucleus_num (context, &n);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(n == nucl_num);
|
|
|
|
double k;
|
|
rc = qmckl_get_nucleus_rescale_factor (context, &k);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(k == 1.0);
|
|
|
|
|
|
rc = qmckl_set_nucleus_rescale_factor (context, nucl_rescale_factor_kappa);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = qmckl_get_nucleus_rescale_factor (context, &k);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
assert(k == nucl_rescale_factor_kappa);
|
|
|
|
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_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*nucl_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
assert(!qmckl_nucleus_provided(context));
|
|
|
|
rc = 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_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_set_nucleus_charge(context, nucl_charge, nucl_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
rc = 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 ~bord_vector~ and the electron-electron rescale factor ~rescale_factor_kappa~.
|
|
|
|
\[
|
|
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_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_asymp_jasb(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) 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
|
|
|
|
*** Provide :noexport:
|
|
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_asymp_jasb(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_asymp_jasb(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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if ee kappa is provided */
|
|
double rescale_factor_kappa_ee;
|
|
rc = qmckl_get_electron_rescale_factor_ee(context, &rescale_factor_kappa_ee);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* 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;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_asymp_jasb(context,
|
|
ctx->jastrow.bord_num,
|
|
ctx->jastrow.bord_vector,
|
|
rescale_factor_kappa_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_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 |
|
|
| ~bord_vector~ | ~double[bord_num+1]~ | in | Values of b |
|
|
| ~rescale_factor_kappa_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_asymp_jasb_f(context, bord_num, bord_vector, rescale_factor_kappa_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) :: bord_vector(bord_num + 1)
|
|
double precision , intent(in) :: rescale_factor_kappa_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_kappa_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 = bord_vector(1) * kappa_inv / (1.0d0 + bord_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) + bord_vector(p + 1) * x
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_asymp_jasb_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_asymp_jasb (
|
|
const qmckl_context context,
|
|
const int64_t bord_num,
|
|
const double* bord_vector,
|
|
const double rescale_factor_kappa_ee,
|
|
double* const asymp_jasb ) {
|
|
|
|
double kappa_inv, x, asym_one;
|
|
|
|
kappa_inv = 1.0 / rescale_factor_kappa_ee;
|
|
|
|
if (context == QMCKL_NULL_CONTEXT){
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (bord_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
asym_one = bord_vector[0] * kappa_inv / (1.0 + bord_vector[1] * kappa_inv);
|
|
asymp_jasb[0] = asym_one;
|
|
asymp_jasb[1] = 0.5 * asym_one;
|
|
|
|
for (int i = 0 ; i <= 1; ++i) {
|
|
x = kappa_inv;
|
|
for (int p = 1; p < bord_num; ++p){
|
|
x = x * kappa_inv;
|
|
asymp_jasb[i] = asymp_jasb[i] + bord_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code qmckl_compute_asymp_jasb (
|
|
const qmckl_context context,
|
|
const int64_t bord_num,
|
|
const double* bord_vector,
|
|
const double rescale_factor_kappa_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 = bord_vector[0] * kappa_inv / (1.0 + bord_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] += bord_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* aord_vector = &(n2_aord_vector[0][0]);
|
|
double* bord_vector = &(n2_bord_vector[0]);
|
|
double* cord_vector = &(n2_cord_vector[0][0]);
|
|
int64_t dim_cord_vect=0;
|
|
|
|
/* Initialize the Jastrow data */
|
|
rc = qmckl_init_jastrow(context);
|
|
assert(!qmckl_jastrow_provided(context));
|
|
|
|
/* Set the data */
|
|
rc = qmckl_set_jastrow_ord_num(context, aord_num, bord_num, cord_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_set_jastrow_type_nucl_num(context, type_nucl_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_set_jastrow_type_nucl_vector(context, type_nucl_vector, nucl_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_set_jastrow_aord_vector(context, aord_vector,(aord_num+1)*type_nucl_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_set_jastrow_bord_vector(context, bord_vector,(bord_num+1));
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_get_jastrow_dim_cord_vect(context, &dim_cord_vect);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
rc = qmckl_set_jastrow_cord_vector(context, cord_vector,dim_cord_vect*type_nucl_num);
|
|
assert(rc == QMCKL_SUCCESS);
|
|
|
|
/* 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}} - J_{asymp} + \sum^{nord}_{k}B_k C_{ij}^k \right\}
|
|
\]
|
|
|
|
|
|
*** 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)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_factor_ee(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze=ctx->electron.walk_num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_ee",
|
|
"Array too small. Expected walk_num");
|
|
}
|
|
memcpy(factor_ee, ctx->jastrow.factor_ee, 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_ee(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_factor_ee(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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if ee rescaled distance is provided */
|
|
rc = qmckl_provide_ee_distance_rescaled(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_ee_date) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_ee == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walk_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_factor_ee",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_ee = factor_ee;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_ee(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->electron.up_num,
|
|
ctx->jastrow.bord_num,
|
|
ctx->jastrow.bord_vector,
|
|
ctx->electron.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 |
|
|
| ~bord_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, &
|
|
bord_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) :: bord_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 + bord_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 * bord_vector(1) * &
|
|
ee_distance_rescaled(i,j,nw) / &
|
|
(1.0d0 + bord_vector(2) * &
|
|
ee_distance_rescaled(i,j,nw)) &
|
|
-asymp_jasb(ipar) + power_ser
|
|
|
|
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* bord_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* asymp_jasb,
|
|
double* const factor_ee ) {
|
|
|
|
int ipar; // can we use a smaller integer?
|
|
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 + bord_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 * bord_vector[0] * \
|
|
x1 / \
|
|
(1.0 + bord_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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* bord_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 + bord_vector[p + 1] * x
|
|
|
|
if(i < up_num or j >= up_num):
|
|
spin_fact = 0.5
|
|
ipar = 1
|
|
|
|
factor_ee = factor_ee + spin_fact * bord_vector[0] * ee_distance_rescaled[i][j] \
|
|
/ (1.0 + bord_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_get_jastrow_factor_ee(context, factor_ee, walk_num);
|
|
|
|
// calculate factor_ee
|
|
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_factor_ee_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walk_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_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_factor_ee_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* const) context;
|
|
assert (ctx != 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) {
|
|
|
|
/* 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.walk_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_factor_ee_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_ee_deriv_e = factor_ee_deriv_e;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_ee_deriv_e(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->electron.up_num,
|
|
ctx->jastrow.bord_num,
|
|
ctx->jastrow.bord_vector,
|
|
ctx->electron.ee_distance_rescaled,
|
|
ctx->electron.ee_distance_rescaled_deriv_e,
|
|
ctx->jastrow.asymp_jasb,
|
|
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 |
|
|
| ~bord_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 |
|
|
| ~asymp_jasb~ | ~double[2]~ | 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_f(context, walk_num, elec_num, up_num, bord_num, &
|
|
bord_vector, ee_distance_rescaled, ee_distance_rescaled_deriv_e, &
|
|
asymp_jasb, 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) :: bord_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)
|
|
double precision , intent(in) :: asymp_jasb(2)
|
|
double precision , intent(out) :: factor_ee_deriv_e(elec_num,4,walk_num)
|
|
|
|
integer*8 :: i, j, p, ipar, 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 + bord_vector(2) * x
|
|
invden = 1.0d0 / den
|
|
invden2 = invden * invden
|
|
invden3 = invden2 * invden
|
|
xinv = 1.0d0 / (x + 1.0d-18)
|
|
ipar = 1
|
|
|
|
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 * bord_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 * bord_vector(2) * dx(ii) * dx(ii)
|
|
|
|
factor_ee_deriv_e( j, ii, nw) = factor_ee_deriv_e( j, ii, nw) + spin_fact * bord_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 * bord_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_f
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_header(table=qmckl_factor_ee_deriv_e_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_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* bord_vector,
|
|
const double* ee_distance_rescaled,
|
|
const double* ee_distance_rescaled_deriv_e,
|
|
const double* asymp_jasb,
|
|
double* const factor_ee_deriv_e );
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_ee_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_ee_deriv_e &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
up_num, &
|
|
bord_num, &
|
|
bord_vector, &
|
|
ee_distance_rescaled, &
|
|
ee_distance_rescaled_deriv_e, &
|
|
asymp_jasb, &
|
|
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) :: bord_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(in) :: asymp_jasb(2)
|
|
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_f
|
|
info = qmckl_compute_factor_ee_deriv_e_f &
|
|
(context, &
|
|
walk_num, &
|
|
elec_num, &
|
|
up_num, &
|
|
bord_num, &
|
|
bord_vector, &
|
|
ee_distance_rescaled, &
|
|
ee_distance_rescaled_deriv_e, &
|
|
asymp_jasb, &
|
|
factor_ee_deriv_e)
|
|
|
|
end function qmckl_compute_factor_ee_deriv_e
|
|
#+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 + bord_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 * bord_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 * bord_vector[1] * dx[ii] * dx[ii]
|
|
|
|
factor_ee_deriv_e[ii][j] = factor_ee_deriv_e[ii][j] + spin_fact * bord_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 * bord_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
|
|
|
|
** Electron-nucleus component \(f_{en}\)
|
|
|
|
Calculate the electron-electron jastrow component ~factor_en~ using the ~aord_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_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_factor_en(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze=ctx->electron.walk_num;
|
|
if (size_max < sze) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_INVALID_ARG_3,
|
|
"qmckl_get_jastrow_factor_en",
|
|
"Array too small. Expected walk_num");
|
|
}
|
|
memcpy(factor_en, ctx->jastrow.factor_en, 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_en(qmckl_context context);
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
|
qmckl_exit_code qmckl_provide_factor_en(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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if en rescaled distance is provided */
|
|
rc = qmckl_provide_en_distance_rescaled(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.factor_en_date) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_en == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walk_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_factor_en",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_en = factor_en;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_en(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.aord_num,
|
|
ctx->jastrow.aord_vector,
|
|
ctx->electron.en_distance_rescaled,
|
|
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 |
|
|
| ~aord_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 |
|
|
| ~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, aord_vector, &
|
|
en_distance_rescaled, 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) :: aord_vector(aord_num + 1, type_nucl_num)
|
|
double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_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
|
|
|
|
factor_en = 0.0d0
|
|
|
|
do nw =1, walk_num
|
|
do a = 1, nucl_num
|
|
do i = 1, elec_num
|
|
x = en_distance_rescaled(i, a, nw)
|
|
power_ser = 0.0d0
|
|
|
|
do p = 2, aord_num
|
|
x = x * en_distance_rescaled(i, a, nw)
|
|
power_ser = power_ser + aord_vector(p + 1, type_nucl_vector(a)) * x
|
|
end do
|
|
|
|
factor_en(nw) = factor_en(nw) + aord_vector(1, type_nucl_vector(a)) * &
|
|
en_distance_rescaled(i, a, nw) / &
|
|
(1.0d0 + aord_vector(2, type_nucl_vector(a)) * &
|
|
en_distance_rescaled(i, a, nw)) &
|
|
+ power_ser
|
|
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_factor_en_f
|
|
#+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* aord_vector,
|
|
const double* en_distance_rescaled,
|
|
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 (aord_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 = ee_distance_rescaled[j * (walk_num * elec_num) + i * (walk_num) + nw];
|
|
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 + aord_vector[(p+1)-1 + (type_nucl_vector[a]-1) * aord_num] * x;
|
|
}
|
|
|
|
factor_en[nw] = factor_en[nw] + aord_vector[0 + (type_nucl_vector[a]-1)*aord_num] * x1 / \
|
|
(1.0 + aord_vector[1 + (type_nucl_vector[a]-1) * aord_num] * x1) + \
|
|
power_ser;
|
|
|
|
}
|
|
}
|
|
}
|
|
|
|
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* aord_vector,
|
|
const double* en_distance_rescaled,
|
|
double* const factor_en );
|
|
#+end_src
|
|
|
|
|
|
*** Test
|
|
#+begin_src python :results output :exports none :noweb yes
|
|
import numpy as np
|
|
|
|
<<jastrow_data>>
|
|
|
|
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 + aord_vector[(p-1) + 1][type_nucl_vector[a]-1] * x
|
|
|
|
factor_en = factor_en + aord_vector[0][type_nucl_vector[a]-1] * en_distance_rescaled[i][a] \
|
|
/ (1.0 + aord_vector[1][type_nucl_vector[a]-1] * en_distance_rescaled[i][a]) \
|
|
+ pow_ser
|
|
print("factor_en :",factor_en)
|
|
|
|
#+end_src
|
|
|
|
#+RESULTS:
|
|
: factor_en : -5.865822569188727
|
|
|
|
|
|
#+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(factor_en[0]+5.865822569188727) < 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_factor_en_deriv_e(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walk_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*walk_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_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_factor_en_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* const) context;
|
|
assert (ctx != 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) {
|
|
|
|
/* 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.walk_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_factor_en_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.factor_en_deriv_e = factor_en_deriv_e;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_en_deriv_e(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.aord_num,
|
|
ctx->jastrow.aord_vector,
|
|
ctx->electron.en_distance_rescaled,
|
|
ctx->electron.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 |
|
|
| ~aord_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, aord_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) :: aord_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 + aord_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 * aord_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 * aord_vector(2, type_nucl_vector(a)) * dx(ii) * dx(ii)
|
|
|
|
factor_en_deriv_e(i, ii, nw) = factor_en_deriv_e(i, ii, nw) + aord_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 * aord_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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* aord_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, &
|
|
aord_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) :: aord_vector(aord_num + 1, type_nucl_num)
|
|
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, &
|
|
aord_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 + aord_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 * aord_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 * aord_vector[1][type_nucl_vector[a]-1] * dx[ii] * dx[ii]
|
|
|
|
factor_en_deriv_e[ii][i] = factor_en_deriv_e[ii][i] + aord_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 * (aord_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 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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * ctx->electron.num * ctx->electron.walk_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.walk_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* const) 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) {
|
|
|
|
/* 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.walk_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_een_rescaled_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_e = een_rescaled_e;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_een_rescaled_e(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.rescale_factor_kappa_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_kappa_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_f(context, walk_num, elec_num, cord_num, rescale_factor_kappa_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_kappa_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
|
|
|
|
allocate(een_rescaled_e_ij(elec_num * (elec_num - 1) / 2, cord_num + 1))
|
|
|
|
|
|
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 = 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_kappa_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_f
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_header(table=qmckl_factor_een_rescaled_e_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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_kappa_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=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
|
integer(c_int32_t) function qmckl_compute_een_rescaled_e &
|
|
(context, walk_num, elec_num, cord_num, rescale_factor_kappa_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_kappa_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_f
|
|
info = qmckl_compute_een_rescaled_e_f &
|
|
(context, walk_num, elec_num, cord_num, rescale_factor_kappa_ee, ee_distance, een_rescaled_e)
|
|
|
|
end function qmckl_compute_een_rescaled_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]
|
|
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 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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * 4 * ctx->electron.num * ctx->electron.walk_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.walk_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* const) 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) {
|
|
|
|
/* 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.walk_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_een_rescaled_e_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_e_deriv_e = een_rescaled_e_deriv_e;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_een_rescaled_e_deriv_e(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.rescale_factor_kappa_ee,
|
|
ctx->electron.coord_new.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_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_kappa_ee~ | ~double~ | in | Factor to rescale ee distances |
|
|
| ~coord_new~ | ~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_kappa_ee, &
|
|
coord_new, 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_kappa_ee
|
|
double precision , intent(in) :: coord_new(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_new(i, ii, nw) - coord_new(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_kappa_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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_kappa_ee,
|
|
const double* coord_new,
|
|
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_kappa_ee, &
|
|
coord_new, &
|
|
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_kappa_ee
|
|
real (c_double ) , intent(in) :: coord_new(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_kappa_ee, &
|
|
coord_new, &
|
|
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)
|
|
//assert(qmckl_electron_provided(context));
|
|
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 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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * ctx->nucleus.num * ctx->electron.walk_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.walk_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* const) 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) {
|
|
|
|
/* 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.walk_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_een_rescaled_n",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_n = een_rescaled_n;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_een_rescaled_n(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.rescale_factor_kappa_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 |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~rescale_factor_kappa_en~ | ~double~ | 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, cord_num, rescale_factor_kappa_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) :: cord_num
|
|
double precision , intent(in) :: rescale_factor_kappa_en
|
|
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_kappa_en * 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 cord_num,
|
|
const double rescale_factor_kappa_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] = 17.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) {
|
|
// prepare the actual een table
|
|
//een_rescaled_n(:, :, 0, nw) = 1.0d0
|
|
een_rescaled_n[i + a * elec_num + 0 + nw * elec_num*nucl_num*(cord_num+1)] = 1.0;
|
|
//een_rescaled_n(i, a, 1, nw) = dexp(-rescale_factor_kappa_en * en_distance(i, a, nw))
|
|
een_rescaled_n[i + a*elec_num + elec_num*nucl_num + nw*elec_num*nucl_num*(cord_num+1)] = exp(-rescale_factor_kappa_en * \
|
|
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_header(table=qmckl_factor_een_rescaled_n_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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 cord_num,
|
|
const double rescale_factor_kappa_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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.num * 4 * ctx->nucleus.num * ctx->electron.walk_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.walk_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* const) 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) {
|
|
|
|
/* 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.walk_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_een_rescaled_n_deriv_e",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.een_rescaled_n_deriv_e = een_rescaled_n_deriv_e;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_een_rescaled_n_deriv_e(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.rescale_factor_kappa_en,
|
|
ctx->electron.coord_new.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 |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~rescale_factor_kappa_en~ | ~double~ | in | Factor to rescale ee distances |
|
|
| ~coord_new~ | ~double[walk_num][3][elec_num]~ | in | Electron coordinates |
|
|
| ~coord~ | ~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, &
|
|
cord_num, rescale_factor_kappa_en, &
|
|
coord_new, coord, 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) :: cord_num
|
|
double precision , intent(in) :: rescale_factor_kappa_en
|
|
double precision , intent(in) :: coord_new(elec_num,3,walk_num)
|
|
double precision , intent(in) :: coord(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_new(i, ii, nw) - coord(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
|
|
kappa_l = - dble(l) * rescale_factor_kappa_en
|
|
do a = 1, nucl_num
|
|
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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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 cord_num,
|
|
const double rescale_factor_kappa_en,
|
|
const double* coord_new,
|
|
const double* coord,
|
|
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, &
|
|
cord_num, &
|
|
rescale_factor_kappa_en, &
|
|
coord_new, &
|
|
coord, &
|
|
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 :: cord_num
|
|
real (c_double ) , intent(in) , value :: rescale_factor_kappa_en
|
|
real (c_double ) , intent(in) :: coord_new(elec_num,3,walk_num)
|
|
real (c_double ) , intent(in) :: coord(nucl_num,3)
|
|
real (c_double ) , intent(in) :: en_distance(nucl_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) :: 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, &
|
|
cord_num, &
|
|
rescale_factor_kappa_en, &
|
|
coord_new, &
|
|
coord, &
|
|
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 ~cord_vect_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_cord_vect(qmckl_context context, int64_t* const dim_cord_vect);
|
|
qmckl_exit_code qmckl_get_jastrow_cord_vect_full(qmckl_context context, double* const cord_vect_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_cord_vect(qmckl_context context, int64_t* const dim_cord_vect)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_dim_cord_vect(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
*dim_cord_vect = ctx->jastrow.dim_cord_vect;
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_get_jastrow_cord_vect_full(qmckl_context context, double* const cord_vect_full)
|
|
{
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_exit_code rc;
|
|
|
|
rc = qmckl_provide_dim_cord_vect(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
rc = qmckl_provide_cord_vect_full(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = ctx->jastrow.dim_cord_vect * ctx->nucleus.num;
|
|
memcpy(cord_vect_full, ctx->jastrow.cord_vect_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_dim_cord_vect(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
rc = qmckl_provide_cord_vect_full(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = ctx->jastrow.dim_cord_vect * 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_dim_cord_vect(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
rc = qmckl_provide_cord_vect_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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
size_t sze = (ctx->jastrow.cord_num) * (ctx->jastrow.cord_num + 1)
|
|
* ctx->electron.num * ctx->nucleus.num * ctx->electron.walk_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_dim_cord_vect(context);
|
|
if (rc != QMCKL_SUCCESS) return rc;
|
|
|
|
rc = qmckl_provide_cord_vect_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* const) 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.walk_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_dim_cord_vect(qmckl_context context);
|
|
qmckl_exit_code qmckl_provide_cord_vect_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_dim_cord_vect(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.dim_cord_vect_date) {
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_dim_cord_vect(context,
|
|
ctx->jastrow.cord_num,
|
|
&(ctx->jastrow.dim_cord_vect));
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.dim_cord_vect_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_provide_cord_vect_full(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if dim_cord_vect is provided */
|
|
qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.cord_vect_full_date) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.cord_vect_full == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->jastrow.dim_cord_vect * ctx->nucleus.num * sizeof(double);
|
|
double* cord_vect_full = (double*) qmckl_malloc(context, mem_info);
|
|
|
|
if (cord_vect_full == NULL) {
|
|
return qmckl_failwith( context,
|
|
QMCKL_ALLOCATION_FAILED,
|
|
"qmckl_provide_cord_vect_full",
|
|
NULL);
|
|
}
|
|
ctx->jastrow.cord_vect_full = cord_vect_full;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_cord_vect_full(context,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.dim_cord_vect,
|
|
ctx->jastrow.type_nucl_num,
|
|
ctx->jastrow.type_nucl_vector,
|
|
ctx->jastrow.cord_vector,
|
|
ctx->jastrow.cord_vect_full);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.cord_vect_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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if dim_cord_vect is provided */
|
|
qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* 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_cord_vect * 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 =
|
|
qmckl_compute_lkpm_combined_index(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.dim_cord_vect,
|
|
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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if dim_cord_vect is provided */
|
|
qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.tmp_c_date) {
|
|
|
|
/* 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.walk_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;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_tmp_c(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walk_num,
|
|
ctx->jastrow.een_rescaled_e,
|
|
ctx->jastrow.een_rescaled_n,
|
|
ctx->jastrow.tmp_c);
|
|
if (rc != QMCKL_SUCCESS) {
|
|
return rc;
|
|
}
|
|
|
|
ctx->jastrow.tmp_c_date = ctx->date;
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
|
|
qmckl_exit_code qmckl_provide_dtmp_c(qmckl_context context)
|
|
{
|
|
|
|
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_NULL_CONTEXT;
|
|
}
|
|
|
|
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
/* Check if dim_cord_vect is provided */
|
|
qmckl_exit_code rc = qmckl_provide_dim_cord_vect(context);
|
|
if(rc != QMCKL_SUCCESS) return rc;
|
|
|
|
/* Compute if necessary */
|
|
if (ctx->date > ctx->jastrow.dtmp_c_date) {
|
|
|
|
/* 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.walk_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;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_dtmp_c(context,
|
|
ctx->jastrow.cord_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->electron.walk_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_cord_vect
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_dim_cord_vect
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_dim_cord_vect_args
|
|
| Variable | Type | In/Out | Description |
|
|
|-----------------+-----------------+--------+-----------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~cord_num~ | ~int64_t~ | in | Order of polynomials |
|
|
| ~dim_cord_vect~ | ~int64_t~ | out | dimension of cord_vect_full table |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_dim_cord_vect_f(context, cord_num, dim_cord_vect) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: cord_num
|
|
integer*8 , intent(out) :: dim_cord_vect
|
|
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_cord_vect = 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_cord_vect = dim_cord_vect + 1
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
end function qmckl_compute_dim_cord_vect_f
|
|
#+end_src
|
|
|
|
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
|
qmckl_exit_code qmckl_compute_dim_cord_vect (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
int64_t* const dim_cord_vect){
|
|
|
|
int lmax;
|
|
|
|
|
|
if (context == QMCKL_NULL_CONTEXT) {
|
|
return QMCKL_INVALID_CONTEXT;
|
|
}
|
|
|
|
if (cord_num <= 0) {
|
|
return QMCKL_INVALID_ARG_2;
|
|
}
|
|
|
|
*dim_cord_vect = 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_cord_vect=*dim_cord_vect+1;
|
|
}
|
|
}
|
|
}
|
|
|
|
return QMCKL_SUCCESS;
|
|
}
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_header(table=qmckl_factor_dim_cord_vect_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code qmckl_compute_dim_cord_vect (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
int64_t* const dim_cord_vect );
|
|
#+end_src
|
|
|
|
|
|
*** Compute cord_vect_full
|
|
:PROPERTIES:
|
|
:Name: qmckl_compute_cord_vect_full
|
|
:CRetType: qmckl_exit_code
|
|
:FRetType: qmckl_exit_code
|
|
:END:
|
|
|
|
#+NAME: qmckl_factor_cord_vect_full_args
|
|
| Variable | Type | In/Out | Description |
|
|
|--------------------+----------------------------------------+--------+------------------------------|
|
|
| ~context~ | ~qmckl_context~ | in | Global state |
|
|
| ~nucl_num~ | ~int64_t~ | in | Number of atoms |
|
|
| ~dim_cord_vect~ | ~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 |
|
|
| ~cord_vector~ | ~double[dim_cord_vect][type_nucl_num]~ | in | dimension of cord full table |
|
|
| ~cord_vect_full~ | ~double[dim_cord_vect][nucl_num]~ | out | Full list of coefficients |
|
|
|
|
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
|
integer function qmckl_compute_cord_vect_full_f(context, nucl_num, dim_cord_vect, type_nucl_num, &
|
|
type_nucl_vector, cord_vector, cord_vect_full) &
|
|
result(info)
|
|
use qmckl
|
|
implicit none
|
|
integer(qmckl_context), intent(in) :: context
|
|
integer*8 , intent(in) :: nucl_num
|
|
integer*8 , intent(in) :: dim_cord_vect
|
|
integer*8 , intent(in) :: type_nucl_num
|
|
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
|
double precision , intent(in) :: cord_vector(type_nucl_num, dim_cord_vect)
|
|
double precision , intent(out) :: cord_vect_full(nucl_num,dim_cord_vect)
|
|
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_cord_vect <= 0) then
|
|
info = QMCKL_INVALID_ARG_5
|
|
return
|
|
endif
|
|
|
|
|
|
do a = 1, nucl_num
|
|
cord_vect_full(a,1:dim_cord_vect) = cord_vector(type_nucl_vector(a),1:dim_cord_vect)
|
|
end do
|
|
|
|
end function qmckl_compute_cord_vect_full_f
|
|
#+end_src
|
|
|
|
#+CALL: generate_c_header(table=qmckl_factor_cord_vect_full_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code qmckl_compute_cord_vect_full (
|
|
const qmckl_context context,
|
|
const int64_t nucl_num,
|
|
const int64_t dim_cord_vect,
|
|
const int64_t type_nucl_num,
|
|
const int64_t* type_nucl_vector,
|
|
const double* cord_vector,
|
|
double* const cord_vect_full );
|
|
#+end_src
|
|
|
|
|
|
#+CALL: generate_c_interface(table=qmckl_factor_cord_vect_full_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_cord_vect_full &
|
|
(context, nucl_num, dim_cord_vect, type_nucl_num, type_nucl_vector, cord_vector, cord_vect_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_cord_vect
|
|
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) :: cord_vector(type_nucl_num,dim_cord_vect)
|
|
real (c_double ) , intent(out) :: cord_vect_full(nucl_num,dim_cord_vect)
|
|
|
|
integer(c_int32_t), external :: qmckl_compute_cord_vect_full_f
|
|
info = qmckl_compute_cord_vect_full_f &
|
|
(context, nucl_num, dim_cord_vect, type_nucl_num, type_nucl_vector, cord_vector, cord_vect_full)
|
|
|
|
end function qmckl_compute_cord_vect_full
|
|
#+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_cord_vect~ | ~int64_t~ | in | dimension of cord full table |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | 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_cord_vect, &
|
|
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_cord_vect
|
|
integer*8 , intent(out) :: lkpm_combined_index(dim_cord_vect, 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_cord_vect <= 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_cord_vect,
|
|
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_cord_vect <= 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_cord_vect] = k;
|
|
lkpm_combined_index[kk + 2*dim_cord_vect] = p;
|
|
lkpm_combined_index[kk + 3*dim_cord_vect] = 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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
qmckl_exit_code qmckl_compute_lkpm_combined_index (
|
|
const qmckl_context context,
|
|
const int64_t cord_num,
|
|
const int64_t dim_cord_vect,
|
|
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 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
|
|
|
|
#+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
|
|
|
|
|
|
#+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;
|
|
|
|
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[0+0*elec_num+i*elec_num*elec_num+nw*elec_num*elec_num*(cord_num+1)],
|
|
&(een_rescaled_e[ i*elec_num*elec_num+nw*elec_num*elec_num*(cord_num+1)]), \
|
|
LDA, \
|
|
// &een_rescaled_n[0+0*elec_num+0*elec_num*nucl_num+nw*elec_num*nucl_num*(cord_num+1)],
|
|
&(een_rescaled_n[ nw*elec_num*nucl_num*(cord_num+1)]), \
|
|
LDB, \
|
|
beta, \
|
|
// &tmp_c[0+0*elec_num+0*elec_num*nucl_num+i*elec_num*nucl_num*(cord_num+1)+nw*elec_num*nucl_num*(cord_num+1)*cord_num],
|
|
&(tmp_c[ i*elec_num*nucl_num*(cord_num+1)+nw*elec_num*nucl_num*(cord_num+1)*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
|
|
|
|
|
|
#+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
|
|
|
|
TODO: FIX dtmp_c dimension in the table.
|
|
*** 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 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 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;
|
|
|
|
for (int64_t nw=0; nw < walk_num; ++nw) {
|
|
for (int64_t i=0; nw < cord_num; ++i) {
|
|
info = qmckl_dgemm(context, TransA, TransB, M, N, K, alpha, \
|
|
//&een_rescaled_e_deriv_e[0+0*elec_num+0*elec_num*4+i*elec_num*4*elec_num+nw*elec_num*4*elec_num*(cord_num+1)],
|
|
&(een_rescaled_e_deriv_e[i*elec_num*4*elec_num+nw*elec_num*4*elec_num*(cord_num+1)]), \
|
|
LDA, \
|
|
//&een_rescaled_n[0+0*elec_num+0*elec_num*nucl_num+nw*elec_num*nucl_num*(cord_num+1)],
|
|
&(een_rescaled_n[nw*elec_num*nucl_num*(cord_num+1)]), \
|
|
LDB, \
|
|
beta, \
|
|
//&dtmp_c[0+0*elec_num+0*elec_num*4+0*elec_num*4*nucl_num+i*elec_num*4*nucl_num*(cord_num+1)+nw*elec_num*4*nucl_num*(cord_num+1)*cord_num],
|
|
&(dtmp_c[i*elec_num*4*nucl_num*(cord_num+1)+nw*elec_num*4*nucl_num*(cord_num+1)*cord_num]), \
|
|
LDC);
|
|
}
|
|
}
|
|
|
|
return info;
|
|
}
|
|
#+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 c :tangle (eval h_func) :comments org
|
|
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 :tangle (eval h_private_func) :comments org
|
|
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
|
|
|
|
#+begin_src c :tangle (eval h_private_func) :comments org
|
|
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
|
|
|
|
*** 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]));
|
|
|
|
assert(fabs(tmp_c[0][0][1][0][0] - 2.7083473948352403) < 1e-12);
|
|
|
|
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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walk_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
|
|
|
|
*** 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* const) 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_cord_vect_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) {
|
|
|
|
/* Allocate array */
|
|
if (ctx->jastrow.factor_een == NULL) {
|
|
|
|
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
|
mem_info.size = ctx->electron.walk_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;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_een(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.dim_cord_vect,
|
|
ctx->jastrow.cord_vect_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_cord_vect~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~cord_vect_full~ | ~double[dim_cord_vect][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | 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_cord_vect, cord_vect_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_cord_vect
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_cord_vect,4)
|
|
double precision , intent(in) :: cord_vect_full(nucl_num, dim_cord_vect)
|
|
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_cord_vect
|
|
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 = cord_vect_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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_cord_vect,
|
|
const double* cord_vect_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_cord_vect, &
|
|
cord_vect_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_cord_vect
|
|
real (c_double ) , intent(in) :: cord_vect_full(nucl_num,dim_cord_vect)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,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_cord_vect, &
|
|
cord_vect_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_cord_vect~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~cord_vect_full~ | ~double[dim_cord_vect][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | 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_cord_vect, cord_vect_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_cord_vect
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_cord_vect,4)
|
|
double precision , intent(in) :: cord_vect_full(nucl_num, dim_cord_vect)
|
|
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_cord_vect
|
|
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 = cord_vect_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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_cord_vect,
|
|
const double* cord_vect_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_cord_vect, &
|
|
cord_vect_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_cord_vect
|
|
real (c_double ) , intent(in) :: cord_vect_full(nucl_num,dim_cord_vect)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,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_cord_vect, &
|
|
cord_vect_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_cord_vect):
|
|
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 = cord_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* const) context;
|
|
assert (ctx != NULL);
|
|
|
|
int64_t sze = ctx->electron.walk_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* const) 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_cord_vect_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) {
|
|
|
|
/* 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.walk_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;
|
|
}
|
|
|
|
qmckl_exit_code rc =
|
|
qmckl_compute_factor_een_deriv_e(context,
|
|
ctx->electron.walk_num,
|
|
ctx->electron.num,
|
|
ctx->nucleus.num,
|
|
ctx->jastrow.cord_num,
|
|
ctx->jastrow.dim_cord_vect,
|
|
ctx->jastrow.cord_vect_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_cord_vect~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~cord_vect_full~ | ~double[dim_cord_vect][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | 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_cord_vect, cord_vect_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_cord_vect
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_cord_vect, 4)
|
|
double precision , intent(in) :: cord_vect_full(nucl_num, dim_cord_vect)
|
|
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_cord_vect
|
|
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 = cord_vect_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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_cord_vect,
|
|
const double* cord_vect_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_cord_vect, &
|
|
cord_vect_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_cord_vect
|
|
real (c_double ) , intent(in) :: cord_vect_full(nucl_num,dim_cord_vect)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,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_cord_vect, &
|
|
cord_vect_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_cord_vect~ | ~int64_t~ | in | dimension of full coefficient vector |
|
|
| ~cord_vect_full~ | ~double[dim_cord_vect][nucl_num]~ | in | full coefficient vector |
|
|
| ~lkpm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | 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_cord_vect, &
|
|
cord_vect_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_cord_vect
|
|
integer*8 , intent(in) :: lkpm_combined_index(dim_cord_vect,4)
|
|
double precision , intent(in) :: cord_vect_full(nucl_num, dim_cord_vect)
|
|
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_cord_vect
|
|
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 = cord_vect_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"))
|
|
|
|
#+RESULTS:
|
|
#+begin_src c :tangle (eval h_func) :comments org
|
|
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_cord_vect,
|
|
const double* cord_vect_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_cord_vect, &
|
|
cord_vect_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_cord_vect
|
|
real (c_double ) , intent(in) :: cord_vect_full(nucl_num,dim_cord_vect)
|
|
integer (c_int64_t) , intent(in) :: lkpm_combined_index(dim_cord_vect,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_cord_vect, &
|
|
cord_vect_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_cord_vect):
|
|
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 = cord_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
|
|
|
|
* 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
|
|
|
|
|
|
|