mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-07-18 08:53:47 +02:00
GitHub
commit
9f03c32e20
@ -1784,6 +1784,72 @@ integer function qmckl_compute_factor_ee_f(context, walk_num, elec_num, up_num,
|
||||
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 pow_ser, 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:
|
||||
@ -1801,49 +1867,7 @@ end function qmckl_compute_factor_ee_f
|
||||
#+end_src
|
||||
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_factor_ee_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 &
|
||||
(context, &
|
||||
walk_num, &
|
||||
elec_num, &
|
||||
up_num, &
|
||||
bord_num, &
|
||||
bord_vector, &
|
||||
ee_distance_rescaled, &
|
||||
asymp_jasb, &
|
||||
factor_ee) &
|
||||
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) :: asymp_jasb(2)
|
||||
real (c_double ) , intent(out) :: factor_ee(walk_num)
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_factor_ee_f
|
||||
info = qmckl_compute_factor_ee_f &
|
||||
(context, &
|
||||
walk_num, &
|
||||
elec_num, &
|
||||
up_num, &
|
||||
bord_num, &
|
||||
bord_vector, &
|
||||
ee_distance_rescaled, &
|
||||
asymp_jasb, &
|
||||
factor_ee)
|
||||
|
||||
end function qmckl_compute_factor_ee
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
#+begin_src python :results output :exports none :noweb yes
|
||||
@ -2524,6 +2548,74 @@ integer function qmckl_compute_factor_en_f(context, walk_num, elec_num, nucl_num
|
||||
|
||||
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 ) {
|
||||
|
||||
|
||||
int ipar;
|
||||
double x, x1, spin_fact, power_ser;
|
||||
|
||||
|
||||
if (context == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
}
|
||||
|
||||
if (walk_num <= 0) {
|
||||
return QMCKL_INVALID_ARG_2;
|
||||
}
|
||||
|
||||
if (elec_num <= 0) {
|
||||
return QMCKL_INVALID_ARG_3;
|
||||
}
|
||||
|
||||
if (nucl_num <= 0) {
|
||||
return QMCKL_INVALID_ARG_4;
|
||||
}
|
||||
|
||||
if (aord_num <= 0) {
|
||||
return QMCKL_INVALID_ARG_7;
|
||||
}
|
||||
|
||||
|
||||
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"))
|
||||
|
||||
@ -2543,53 +2635,6 @@ end function qmckl_compute_factor_en_f
|
||||
#+end_src
|
||||
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_factor_en_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_compute_factor_en &
|
||||
(context, &
|
||||
walk_num, &
|
||||
elec_num, &
|
||||
nucl_num, &
|
||||
type_nucl_num, &
|
||||
type_nucl_vector, &
|
||||
aord_num, &
|
||||
aord_vector, &
|
||||
en_distance_rescaled, &
|
||||
factor_en) &
|
||||
bind(C) result(info)
|
||||
|
||||
use, intrinsic :: iso_c_binding
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int64_t) , intent(in) , value :: walk_num
|
||||
integer (c_int64_t) , intent(in) , value :: elec_num
|
||||
integer (c_int64_t) , intent(in) , value :: nucl_num
|
||||
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
||||
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
||||
integer (c_int64_t) , intent(in) , value :: aord_num
|
||||
real (c_double ) , intent(in) :: 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(out) :: factor_en(walk_num)
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_factor_en_f
|
||||
info = qmckl_compute_factor_en_f &
|
||||
(context, &
|
||||
walk_num, &
|
||||
elec_num, &
|
||||
nucl_num, &
|
||||
type_nucl_num, &
|
||||
type_nucl_vector, &
|
||||
aord_num, &
|
||||
aord_vector, &
|
||||
en_distance_rescaled, &
|
||||
factor_en)
|
||||
|
||||
end function qmckl_compute_factor_en
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
#+begin_src python :results output :exports none :noweb yes
|
||||
import numpy as np
|
||||
@ -3957,6 +4002,70 @@ integer function qmckl_compute_een_rescaled_n_f(context, walk_num, elec_num, nuc
|
||||
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:
|
||||
@ -3972,47 +4081,6 @@ end function qmckl_compute_een_rescaled_n_f
|
||||
double* const een_rescaled_n );
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_factor_een_rescaled_n_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_compute_een_rescaled_n &
|
||||
(context, &
|
||||
walk_num, &
|
||||
elec_num, &
|
||||
nucl_num, &
|
||||
cord_num, &
|
||||
rescale_factor_kappa_en, &
|
||||
en_distance, &
|
||||
een_rescaled_n) &
|
||||
bind(C) result(info)
|
||||
|
||||
use, intrinsic :: iso_c_binding
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int64_t) , intent(in) , value :: walk_num
|
||||
integer (c_int64_t) , intent(in) , value :: elec_num
|
||||
integer (c_int64_t) , intent(in) , value :: nucl_num
|
||||
integer (c_int64_t) , intent(in) , value :: cord_num
|
||||
real (c_double ) , intent(in) , value :: rescale_factor_kappa_en
|
||||
real (c_double ) , intent(in) :: en_distance(nucl_num,elec_num,walk_num)
|
||||
real (c_double ) , intent(out) :: een_rescaled_n(nucl_num,elec_num,0:cord_num,walk_num)
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_een_rescaled_n_f
|
||||
info = qmckl_compute_een_rescaled_n_f &
|
||||
(context, &
|
||||
walk_num, &
|
||||
elec_num, &
|
||||
nucl_num, &
|
||||
cord_num, &
|
||||
rescale_factor_kappa_en, &
|
||||
en_distance, &
|
||||
een_rescaled_n)
|
||||
|
||||
end function qmckl_compute_een_rescaled_n
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
|
||||
#+begin_src python :results output :exports none :noweb yes
|
||||
@ -4071,7 +4139,6 @@ 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
|
||||
@ -4895,6 +4962,43 @@ integer function qmckl_compute_dim_cord_vect_f(context, cord_num, dim_cord_vect)
|
||||
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:
|
||||
@ -4906,28 +5010,6 @@ end function qmckl_compute_dim_cord_vect_f
|
||||
#+end_src
|
||||
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_factor_dim_cord_vect_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_dim_cord_vect &
|
||||
(context, cord_num, dim_cord_vect) &
|
||||
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(out) :: dim_cord_vect
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_dim_cord_vect_f
|
||||
info = qmckl_compute_dim_cord_vect_f &
|
||||
(context, cord_num, dim_cord_vect)
|
||||
|
||||
end function qmckl_compute_dim_cord_vect
|
||||
#+end_src
|
||||
|
||||
*** Compute cord_vect_full
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_compute_cord_vect_full
|
||||
@ -5046,7 +5128,7 @@ end function qmckl_compute_cord_vect_full_f
|
||||
| ~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 |
|
||||
| ~lpkm_combined_index~ | ~int64_t[4][dim_cord_vect]~ | out | Full list of combined indices |
|
||||
| ~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, &
|
||||
@ -5102,6 +5184,53 @@ integer function qmckl_compute_lkpm_combined_index_f(context, cord_num, dim_cord
|
||||
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:
|
||||
@ -5110,32 +5239,10 @@ end function qmckl_compute_lkpm_combined_index_f
|
||||
const qmckl_context context,
|
||||
const int64_t cord_num,
|
||||
const int64_t dim_cord_vect,
|
||||
int64_t* const lpkm_combined_index );
|
||||
int64_t* const lkpm_combined_index );
|
||||
#+end_src
|
||||
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_factor_lkpm_combined_index_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_lkpm_combined_index &
|
||||
(context, cord_num, dim_cord_vect, lpkm_combined_index) &
|
||||
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 :: dim_cord_vect
|
||||
integer (c_int64_t) , intent(out) :: lpkm_combined_index(dim_cord_vect,4)
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_lkpm_combined_index_f
|
||||
info = qmckl_compute_lkpm_combined_index_f &
|
||||
(context, cord_num, dim_cord_vect, lpkm_combined_index)
|
||||
|
||||
end function qmckl_compute_lkpm_combined_index
|
||||
#+end_src
|
||||
|
||||
*** Compute tmp_c
|
||||
:PROPERTIES:
|
||||
@ -5223,6 +5330,72 @@ integer function qmckl_compute_tmp_c_f(context, cord_num, elec_num, nucl_num, &
|
||||
end function qmckl_compute_tmp_c_f
|
||||
#+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 ) {
|
||||
|
||||
qmckl_exit_code info;
|
||||
int i, j, a, l, kk, p, lmax, nw;
|
||||
char TransA, TransB;
|
||||
double alpha, beta;
|
||||
int M, N, K, LDA, LDB, LDC;
|
||||
|
||||
TransA = 'N';
|
||||
TransB = 'N';
|
||||
alpha = 1.0;
|
||||
beta = 0.0;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
M = elec_num;
|
||||
N = nucl_num*(cord_num + 1);
|
||||
K = elec_num;
|
||||
|
||||
LDA = sizeof(een_rescaled_e)/sizeof(double);
|
||||
LDB = sizeof(een_rescaled_n)/sizeof(double);
|
||||
LDC = sizeof(tmp_c)/sizeof(double);
|
||||
|
||||
for (int nw=0; nw < walk_num; ++nw) {
|
||||
for (int 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=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
@ -5238,34 +5411,7 @@ end function qmckl_compute_tmp_c_f
|
||||
double* const tmp_c );
|
||||
#+end_src
|
||||
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_factor_tmp_c_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_tmp_c &
|
||||
(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_f
|
||||
info = qmckl_compute_tmp_c_f &
|
||||
(context, cord_num, elec_num, nucl_num, walk_num, een_rescaled_e, een_rescaled_n, tmp_c)
|
||||
|
||||
end function qmckl_compute_tmp_c
|
||||
#+end_src
|
||||
|
||||
TODO: FIX dtmp_c dimension in the table.
|
||||
*** Compute dtmp_c
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_compute_dtmp_c
|
||||
@ -5352,6 +5498,71 @@ integer function qmckl_compute_dtmp_c_f(context, cord_num, elec_num, nucl_num, &
|
||||
end function qmckl_compute_dtmp_c_f
|
||||
#+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 ) {
|
||||
|
||||
qmckl_exit_code info;
|
||||
char TransA, TransB;
|
||||
double alpha, beta;
|
||||
int M, N, K, LDA, LDB, LDC;
|
||||
|
||||
TransA = 'N';
|
||||
TransB = 'N';
|
||||
alpha = 1.0;
|
||||
beta = 0.0;
|
||||
|
||||
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;
|
||||
}
|
||||
|
||||
M = 4*elec_num;
|
||||
N = nucl_num*(cord_num + 1);
|
||||
K = elec_num;
|
||||
|
||||
LDA = 4*sizeof(een_rescaled_e_deriv_e)/sizeof(double);
|
||||
LDB = sizeof(een_rescaled_n)/sizeof(double);
|
||||
LDC = 4*sizeof(dtmp_c)/sizeof(double);
|
||||
|
||||
for (int nw=0; nw < walk_num; ++nw) {
|
||||
for (int 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
|
||||
|
||||
#+CALL: generate_c_header(table=qmckl_factor_dtmp_c_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
@ -5368,33 +5579,6 @@ end function qmckl_compute_dtmp_c_f
|
||||
#+end_src
|
||||
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_factor_dtmp_c_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_dtmp_c &
|
||||
(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_f
|
||||
info = qmckl_compute_dtmp_c_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
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
|
||||
#+name: helper_funcs
|
||||
|
||||
Loading…
Reference in New Issue
Block a user