TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-11-19 20:42:50 +01:00
Code Issues Projects Releases Wiki Activity

Introduced qmckl_constants module

Browse Source
This commit is contained in:
Anthony Scemama 2023-09-22 09:33:54 +02:00
parent 7a995a0f6b
commit 50fa3aa754
3 changed files with 180 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
org/qmckl_distance.org
View File

@ -90,20 +90,27 @@ int main() {
#+end_src
#+begin_src f90 :tangle (eval f)
integer function qmckl_distance_sq_f(context, transa, transb, m, n, &
function qmckl_distance_sq(context, transa, transb, m, n, &
A, LDA, B, LDB, C, LDC) &
result(info)
use qmckl
bind(C) result(info)
use, intrinsic :: iso_c_binding
use qmckl_constants
implicit none
integer(qmckl_context) , intent(in) :: context
character , intent(in) :: transa, transb
integer*8 , intent(in) :: m, n
integer*8 , intent(in) :: lda
real*8 , intent(in) :: A(lda,*)
integer*8 , intent(in) :: ldb
real*8 , intent(in) :: B(ldb,*)
integer*8 , intent(in) :: ldc
real*8 , intent(out) :: C(ldc,*)
integer (qmckl_context) , intent(in) , value :: context
character(c_char) , intent(in) , value :: transa
character(c_char) , intent(in) , value :: transb
integer (c_int64_t) , intent(in) , value :: m
integer (c_int64_t) , intent(in) , value :: n
real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: lda
real (c_double ) , intent(in) :: B(ldb,*)
integer (c_int64_t) , intent(in) , value :: ldb
real (c_double ) , intent(out) :: C(ldc,n)
integer (c_int64_t) , intent(in) , value :: ldc
integer(qmckl_exit_code) :: info
integer*8 :: i,j
real*8 :: x, y, z
@ -216,7 +223,7 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, &
end select
end function qmckl_distance_sq_f
end function qmckl_distance_sq
#+end_src
*** Performance
@ -224,36 +231,6 @@ end function qmckl_distance_sq_f
This function is more efficient when ~A~ and ~B~ are
transposed.
#+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
#+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_distance_sq &
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
character(c_char) , intent(in) , value :: transa
character(c_char) , intent(in) , value :: transb
integer (c_int64_t) , intent(in) , value :: m
integer (c_int64_t) , intent(in) , value :: n
real (c_double ) , intent(in) :: A(lda,*)
integer (c_int64_t) , intent(in) , value :: lda
real (c_double ) , intent(in) :: B(ldb,*)
integer (c_int64_t) , intent(in) , value :: ldb
real (c_double ) , intent(out) :: C(ldc,n)
integer (c_int64_t) , intent(in) , value :: ldc
integer(c_int32_t), external :: qmckl_distance_sq_f
info = qmckl_distance_sq_f &
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc)
end function qmckl_distance_sq
#+end_src
#+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
#+RESULTS:

337
org/qmckl_jastrow_champ.org
View File

@ -4123,26 +4123,33 @@ qmckl_exit_code qmckl_provide_jastrow_champ_factor_en(qmckl_context context)
| ~type_nucl_num~ | ~int64_t~ | in | Number of unique nuclei |
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nuclei |
| ~aord_num~ | ~int64_t~ | in | Number of coefficients |
| ~a_vector~ | ~double[aord_num+1][type_nucl_num]~ | in | List of coefficients |
| ~a_vector~ | ~double[type_nucl_num][aord_num+1]~ | in | List of coefficients |
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | in | Electron-nucleus distances |
| ~asymp_jasa~ | ~double[type_nucl_num]~ | in | Type of nuclei |
| ~factor_en~ | ~double[walk_num]~ | out | Electron-nucleus jastrow |
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_jastrow_champ_factor_en_doc_f( &
function qmckl_compute_jastrow_champ_factor_en_doc( &
context, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, asymp_jasa, factor_en) &
result(info)
bind(C) result(info)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num)
double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num)
double precision , intent(in) :: asymp_jasa(type_nucl_num)
double precision , intent(out) :: factor_en(walk_num)
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in) , value :: walk_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in) , value :: aord_num
real (c_double ) , intent(in) :: a_vector(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) :: asymp_jasa(type_nucl_num)
real (c_double ) , intent(out) :: factor_en(walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: i, a, p, nw
double precision :: x, power_ser
@ -4198,59 +4205,9 @@ integer function qmckl_compute_jastrow_champ_factor_en_doc_f( &
end do
end do
end function qmckl_compute_jastrow_champ_factor_en_doc_f
end function qmckl_compute_jastrow_champ_factor_en_doc
#+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_jastrow_champ_factor_en_doc &
(context, &
walk_num, &
elec_num, &
nucl_num, &
type_nucl_num, &
type_nucl_vector, &
aord_num, &
a_vector, &
en_distance_rescaled, &
asymp_jasa, &
factor_en) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: walk_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in) , value :: aord_num
real (c_double ) , intent(in) :: a_vector(type_nucl_num,aord_num+1)
real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real (c_double ) , intent(in) :: asymp_jasa(type_nucl_num)
real (c_double ) , intent(out) :: factor_en(walk_num)
integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_en_doc_f
info = qmckl_compute_jastrow_champ_factor_en_doc_f &
(context, &
walk_num, &
elec_num, &
nucl_num, &
type_nucl_num, &
type_nucl_vector, &
aord_num, &
a_vector, &
en_distance_rescaled, &
asymp_jasa, &
factor_en)
end function qmckl_compute_jastrow_champ_factor_en_doc
#+end_src
#+CALL: generate_c_header(table=qmckl_factor_en_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
#+RESULTS:
@ -4412,7 +4369,7 @@ double factor_en[walk_num];
rc = qmckl_get_jastrow_champ_factor_en(context, factor_en,walk_num);
// calculate factor_en
printf("%f %f\n", factor_en[0], 2.781375792083587);
printf("%f %f\n", factor_en[0], 22.781375792083587);
assert(fabs(22.781375792083587 - factor_en[0]) < 1.e-12);
#+end_src
@ -4585,26 +4542,33 @@ qmckl_exit_code qmckl_provide_jastrow_champ_factor_en_gl(qmckl_context context)
| ~type_nucl_num~ | ~int64_t~ | in | Number of unique nuclei |
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nuclei |
| ~aord_num~ | ~int64_t~ | in | Number of coefficients |
| ~a_vector~ | ~double[aord_num+1][type_nucl_num]~ | in | List of coefficients |
| ~a_vector~ | ~double[type_nucl_num][aord_num+1]~ | in | List of coefficients |
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | in | Electron-nucleus distances |
| ~en_distance_rescaled_gl~ | ~double[walk_num][4][nucl_num][elec_num]~ | in | Electron-nucleus distance derivatives |
| ~en_distance_rescaled_gl~ | ~double[walk_num][nucl_num][elec_num][4]~ | in | Electron-nucleus distance derivatives |
| ~factor_en_gl~ | ~double[walk_num][4][elec_num]~ | out | Electron-nucleus jastrow |
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_jastrow_champ_factor_en_gl_doc_f( &
function qmckl_compute_jastrow_champ_factor_en_gl_doc( &
context, walk_num, elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, aord_num, a_vector, &
en_distance_rescaled, en_distance_rescaled_gl, factor_en_gl) &
result(info)
bind(C) result(info)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num)
double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num)
double precision , intent(in) :: en_distance_rescaled_gl(4, elec_num, nucl_num, walk_num)
double precision , intent(out) :: factor_en_gl(elec_num,4,walk_num)
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in) , value :: walk_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in) , value :: aord_num
real (c_double ) , intent(in) :: a_vector(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_gl(4, elec_num,nucl_num,walk_num)
real (c_double ) , intent(out) :: factor_en_gl(elec_num,4,walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: i, a, k, nw, ii
double precision :: x, x1, kf
@ -4683,8 +4647,8 @@ integer function qmckl_compute_jastrow_champ_factor_en_gl_doc_f( &
end do
end do
end do
end function qmckl_compute_jastrow_champ_factor_en_gl_doc_f
end function qmckl_compute_jastrow_champ_factor_en_gl_doc
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
@ -4845,56 +4809,6 @@ qmckl_compute_jastrow_champ_factor_en_gl (const qmckl_context context,
}
#+end_src
#+CALL: generate_c_interface(table=qmckl_factor_en_gl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_jastrow_champ_factor_en_gl_doc")
#+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_compute_jastrow_champ_factor_en_gl_doc &
(context, &
walk_num, &
elec_num, &
nucl_num, &
type_nucl_num, &
type_nucl_vector, &
aord_num, &
a_vector, &
en_distance_rescaled, &
en_distance_rescaled_gl, &
factor_en_gl) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: walk_num
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
integer (c_int64_t) , intent(in) , value :: aord_num
real (c_double ) , intent(in) :: a_vector(type_nucl_num,aord_num+1)
real (c_double ) , intent(in) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
real (c_double ) , intent(in) :: en_distance_rescaled_gl(elec_num,nucl_num,4,walk_num)
real (c_double ) , intent(out) :: factor_en_gl(elec_num,4,walk_num)
integer(c_int32_t), external :: qmckl_compute_jastrow_champ_factor_en_gl_doc_f
info = qmckl_compute_jastrow_champ_factor_en_gl_doc_f &
(context, &
walk_num, &
elec_num, &
nucl_num, &
type_nucl_num, &
type_nucl_vector, &
aord_num, &
a_vector, &
en_distance_rescaled, &
en_distance_rescaled_gl, &
factor_en_gl)
end function qmckl_compute_jastrow_champ_factor_en_gl_doc
#+end_src
**** Test
#+begin_src python :results output :exports none :noweb yes
import numpy as np
@ -5145,22 +5059,25 @@ qmckl_exit_code qmckl_provide_en_distance_rescaled(qmckl_context context)
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | out | Electron-nucleus distances |
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
integer function qmckl_compute_en_distance_rescaled_f(context, elec_num, nucl_num, type_nucl_num, &
function qmckl_compute_en_distance_rescaled_doc(context, &
elec_num, nucl_num, type_nucl_num, &
type_nucl_vector, rescale_factor_en, walk_num, elec_coord, &
nucl_coord, en_distance_rescaled) &
result(info)
bind(C) result(info)
use, intrinsic :: iso_c_binding
use qmckl
implicit none
integer(qmckl_context), intent(in) :: context
integer*8 , intent(in) :: elec_num
integer*8 , intent(in) :: nucl_num
integer*8 , intent(in) :: type_nucl_num
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
double precision , intent(in) :: rescale_factor_en(type_nucl_num)
integer*8 , intent(in) :: walk_num
double precision , intent(in) :: elec_coord(elec_num,walk_num,3)
double precision , intent(in) :: nucl_coord(nucl_num,3)
double precision , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
integer (qmckl_context), intent(in), value :: context
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num)
integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
integer(qmckl_exit_code) :: info
integer*8 :: i, k
double precision :: coord(3)
@ -5199,16 +5116,89 @@ integer function qmckl_compute_en_distance_rescaled_f(context, elec_num, nucl_nu
end do
end do
end function qmckl_compute_en_distance_rescaled_f
end function qmckl_compute_en_distance_rescaled_doc
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_compute_en_distance_rescaled_hpc (
const qmckl_context context,
const int64_t elec_num,
const int64_t nucl_num,
const int64_t type_nucl_num,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* elec_coord,
const double* nucl_coord,
double* const en_distance_rescaled )
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT;
if (elec_num <= 0) return QMCKL_INVALID_ARG_2;
if (nucl_num <= 0) return QMCKL_INVALID_ARG_3;
if (type_nucl_num <= 0) return QMCKL_INVALID_ARG_4;
if (type_nucl_vector == NULL) return QMCKL_INVALID_ARG_5;
if (rescale_factor_en == NULL) return QMCKL_INVALID_ARG_6;
if (walk_num <= 0) return QMCKL_INVALID_ARG_7;
if (elec_coord == NULL) return QMCKL_INVALID_ARG_8;
if (nucl_coord == NULL) return QMCKL_INVALID_ARG_9;
if (en_distance_rescaled == NULL) return QMCKL_INVALID_ARG_10;
int64_t sze = elec_num*walk_num;
qmckl_exit_code result = QMCKL_SUCCESS;
#pragma omp parallel
{
qmckl_exit_code rc = QMCKL_SUCCESS;
#pragma omp for
for (int64_t k=0 ; k<walk_num ; ++k)
{
for (int64_t a=0 ; a<nucl_num ; ++a) {
const double coord[3] = { nucl_coord[a], nucl_coord[a+nucl_num], nucl_coord[a+2*nucl_num] };
rc |= qmckl_distance_rescaled(context, 'T', 'N', elec_num, 1,
&(elec_coord[k*elec_num]), sze,
coord, 3,
&(en_distance_rescaled[elec_num*(a+nucl_num*k)]), elec_num,
rescale_factor_en[type_nucl_vector[a]]);
}
}
#pragma omp critical
result |= rc;
}
return result;
}
#+end_src
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
qmckl_exit_code qmckl_compute_en_distance_rescaled_doc (
const qmckl_context context,
const int64_t elec_num,
const int64_t nucl_num,
const int64_t type_nucl_num,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* elec_coord,
const double* nucl_coord,
double* const en_distance_rescaled );
qmckl_exit_code qmckl_compute_en_distance_rescaled_hpc (
const qmckl_context context,
const int64_t elec_num,
const int64_t nucl_num,
const int64_t type_nucl_num,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* elec_coord,
const double* nucl_coord,
double* const en_distance_rescaled );
qmckl_exit_code qmckl_compute_en_distance_rescaled (
const qmckl_context context,
const int64_t elec_num,
const int64_t nucl_num,
const int64_t type_nucl_num,
int64_t* const type_nucl_vector,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* elec_coord,
@ -5216,52 +5206,28 @@ qmckl_exit_code qmckl_compute_en_distance_rescaled (
double* const en_distance_rescaled );
#+end_src
#+CALL: generate_c_interface(table=qmckl_en_distance_rescaled_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
#+RESULTS:
#+begin_src f90 :tangle (eval f) :comments org :exports none
integer(c_int32_t) function qmckl_compute_en_distance_rescaled &
(context, &
elec_num, &
nucl_num, &
type_nucl_num, &
type_nucl_vector, &
rescale_factor_en, &
walk_num, &
elec_coord, &
nucl_coord, &
en_distance_rescaled) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: elec_num
integer (c_int64_t) , intent(in) , value :: nucl_num
integer (c_int64_t) , intent(in) , value :: type_nucl_num
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num)
integer (c_int64_t) , intent(in) , value :: walk_num
real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
real (c_double ) , intent(in) :: nucl_coord(elec_num,3)
real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
integer(c_int32_t), external :: qmckl_compute_en_distance_rescaled_f
info = qmckl_compute_en_distance_rescaled_f &
(context, &
elec_num, &
nucl_num, &
type_nucl_num, &
type_nucl_vector, &
rescale_factor_en, &
walk_num, &
elec_coord, &
nucl_coord, &
en_distance_rescaled)
end function qmckl_compute_en_distance_rescaled
#+end_src
#+begin_src c :tangle (eval c) :comments org :exports none
qmckl_exit_code qmckl_compute_en_distance_rescaled (
const qmckl_context context,
const int64_t elec_num,
const int64_t nucl_num,
const int64_t type_nucl_num,
const int64_t* type_nucl_vector,
const double* rescale_factor_en,
const int64_t walk_num,
const double* elec_coord,
const double* nucl_coord,
double* const en_distance_rescaled )
{
#ifdef HAVE_HPC
return qmckl_compute_en_distance_rescaled_hpc
#else
return qmckl_compute_en_distance_rescaled_doc
#endif
(context, elec_num, nucl_num, type_nucl_num, type_nucl_vector,
rescale_factor_en, walk_num, elec_coord, nucl_coord, en_distance_rescaled );
}
#+end_src
**** Test
@ -5578,7 +5544,6 @@ qmckl_exit_code qmckl_compute_en_distance_rescaled_gl_hpc (
if (nucl_coord == NULL) return QMCKL_INVALID_ARG_9;
if (en_distance_rescaled_gl == NULL) return QMCKL_INVALID_ARG_10;
int64_t sze = elec_num*walk_num;
qmckl_exit_code result = QMCKL_SUCCESS;

10
tools/build_qmckl_f.sh
View File

@ -76,7 +76,7 @@ cat << EOF > ${qmckl_f}
!
!
!
module qmckl
module qmckl_constants
use, intrinsic :: iso_c_binding
EOF
@ -85,6 +85,14 @@ do
cat $i >> ${qmckl_f}
done
cat << EOF >> ${qmckl_f}
end module qmckl_constants
module qmckl
use, intrinsic :: iso_c_binding
use qmckl_constants
EOF
for i in ${HEADERS}
do
cat $i >> ${qmckl_f}