mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-12-22 12:23:56 +01:00
Introduced qmckl_constants module
This commit is contained in:
parent
7a995a0f6b
commit
50fa3aa754
@ -90,20 +90,27 @@ int main() {
|
|||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+begin_src f90 :tangle (eval f)
|
#+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) &
|
A, LDA, B, LDB, C, LDC) &
|
||||||
result(info)
|
bind(C) result(info)
|
||||||
use qmckl
|
use, intrinsic :: iso_c_binding
|
||||||
|
|
||||||
|
use qmckl_constants
|
||||||
implicit none
|
implicit none
|
||||||
integer(qmckl_context) , intent(in) :: context
|
|
||||||
character , intent(in) :: transa, transb
|
integer (qmckl_context) , intent(in) , value :: context
|
||||||
integer*8 , intent(in) :: m, n
|
character(c_char) , intent(in) , value :: transa
|
||||||
integer*8 , intent(in) :: lda
|
character(c_char) , intent(in) , value :: transb
|
||||||
real*8 , intent(in) :: A(lda,*)
|
integer (c_int64_t) , intent(in) , value :: m
|
||||||
integer*8 , intent(in) :: ldb
|
integer (c_int64_t) , intent(in) , value :: n
|
||||||
real*8 , intent(in) :: B(ldb,*)
|
real (c_double ) , intent(in) :: A(lda,*)
|
||||||
integer*8 , intent(in) :: ldc
|
integer (c_int64_t) , intent(in) , value :: lda
|
||||||
real*8 , intent(out) :: C(ldc,*)
|
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
|
integer*8 :: i,j
|
||||||
real*8 :: x, y, z
|
real*8 :: x, y, z
|
||||||
@ -216,7 +223,7 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, &
|
|||||||
|
|
||||||
end select
|
end select
|
||||||
|
|
||||||
end function qmckl_distance_sq_f
|
end function qmckl_distance_sq
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
*** Performance
|
*** Performance
|
||||||
@ -224,36 +231,6 @@ end function qmckl_distance_sq_f
|
|||||||
This function is more efficient when ~A~ and ~B~ are
|
This function is more efficient when ~A~ and ~B~ are
|
||||||
transposed.
|
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"))
|
#+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||||
|
|
||||||
#+RESULTS:
|
#+RESULTS:
|
||||||
|
@ -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_num~ | ~int64_t~ | in | Number of unique nuclei |
|
||||||
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nuclei |
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nuclei |
|
||||||
| ~aord_num~ | ~int64_t~ | in | Number of coefficients |
|
| ~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~ | ~double[walk_num][nucl_num][elec_num]~ | in | Electron-nucleus distances |
|
||||||
| ~asymp_jasa~ | ~double[type_nucl_num]~ | in | Type of nuclei |
|
| ~asymp_jasa~ | ~double[type_nucl_num]~ | in | Type of nuclei |
|
||||||
| ~factor_en~ | ~double[walk_num]~ | out | Electron-nucleus jastrow |
|
| ~factor_en~ | ~double[walk_num]~ | out | Electron-nucleus jastrow |
|
||||||
|
|
||||||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
#+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, &
|
context, walk_num, elec_num, nucl_num, type_nucl_num, &
|
||||||
type_nucl_vector, aord_num, a_vector, &
|
type_nucl_vector, aord_num, a_vector, &
|
||||||
en_distance_rescaled, asymp_jasa, factor_en) &
|
en_distance_rescaled, asymp_jasa, factor_en) &
|
||||||
result(info)
|
bind(C) result(info)
|
||||||
|
use, intrinsic :: iso_c_binding
|
||||||
use qmckl
|
use qmckl
|
||||||
implicit none
|
implicit none
|
||||||
integer(qmckl_context), intent(in) :: context
|
|
||||||
integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num
|
integer (qmckl_context), intent(in), value :: context
|
||||||
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
||||||
double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num)
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
||||||
double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num)
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
||||||
double precision , intent(in) :: asymp_jasa(type_nucl_num)
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
||||||
double precision , intent(out) :: factor_en(walk_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
|
integer*8 :: i, a, p, nw
|
||||||
double precision :: x, power_ser
|
double precision :: x, power_ser
|
||||||
@ -4198,59 +4205,9 @@ integer function qmckl_compute_jastrow_champ_factor_en_doc_f( &
|
|||||||
end do
|
end do
|
||||||
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
|
#+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"))
|
#+CALL: generate_c_header(table=qmckl_factor_en_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||||
|
|
||||||
#+RESULTS:
|
#+RESULTS:
|
||||||
@ -4412,7 +4369,7 @@ double factor_en[walk_num];
|
|||||||
rc = qmckl_get_jastrow_champ_factor_en(context, factor_en,walk_num);
|
rc = qmckl_get_jastrow_champ_factor_en(context, factor_en,walk_num);
|
||||||
|
|
||||||
// calculate factor_en
|
// 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);
|
assert(fabs(22.781375792083587 - factor_en[0]) < 1.e-12);
|
||||||
|
|
||||||
#+end_src
|
#+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_num~ | ~int64_t~ | in | Number of unique nuclei |
|
||||||
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nuclei |
|
| ~type_nucl_vector~ | ~int64_t[nucl_num]~ | in | IDs of unique nuclei |
|
||||||
| ~aord_num~ | ~int64_t~ | in | Number of coefficients |
|
| ~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~ | ~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 |
|
| ~factor_en_gl~ | ~double[walk_num][4][elec_num]~ | out | Electron-nucleus jastrow |
|
||||||
|
|
||||||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
#+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, &
|
context, walk_num, elec_num, nucl_num, type_nucl_num, &
|
||||||
type_nucl_vector, aord_num, a_vector, &
|
type_nucl_vector, aord_num, a_vector, &
|
||||||
en_distance_rescaled, en_distance_rescaled_gl, factor_en_gl) &
|
en_distance_rescaled, en_distance_rescaled_gl, factor_en_gl) &
|
||||||
result(info)
|
bind(C) result(info)
|
||||||
|
use, intrinsic :: iso_c_binding
|
||||||
use qmckl
|
use qmckl
|
||||||
implicit none
|
implicit none
|
||||||
integer(qmckl_context), intent(in) :: context
|
|
||||||
integer*8 , intent(in) :: walk_num, elec_num, aord_num, nucl_num, type_nucl_num
|
integer (qmckl_context), intent(in), value :: context
|
||||||
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
||||||
double precision , intent(in) :: a_vector(aord_num + 1, type_nucl_num)
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
||||||
double precision , intent(in) :: en_distance_rescaled(elec_num, nucl_num, walk_num)
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
||||||
double precision , intent(in) :: en_distance_rescaled_gl(4, elec_num, nucl_num, walk_num)
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
||||||
double precision , intent(out) :: factor_en_gl(elec_num,4,walk_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
|
integer*8 :: i, a, k, nw, ii
|
||||||
double precision :: x, x1, kf
|
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 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
|
#+end_src
|
||||||
|
|
||||||
#+begin_src c :tangle (eval c) :comments org :exports none
|
#+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
|
#+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
|
**** Test
|
||||||
#+begin_src python :results output :exports none :noweb yes
|
#+begin_src python :results output :exports none :noweb yes
|
||||||
import numpy as np
|
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 |
|
| ~en_distance_rescaled~ | ~double[walk_num][nucl_num][elec_num]~ | out | Electron-nucleus distances |
|
||||||
|
|
||||||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
#+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, &
|
type_nucl_vector, rescale_factor_en, walk_num, elec_coord, &
|
||||||
nucl_coord, en_distance_rescaled) &
|
nucl_coord, en_distance_rescaled) &
|
||||||
result(info)
|
bind(C) result(info)
|
||||||
|
use, intrinsic :: iso_c_binding
|
||||||
use qmckl
|
use qmckl
|
||||||
implicit none
|
implicit none
|
||||||
integer(qmckl_context), intent(in) :: context
|
integer (qmckl_context), intent(in), value :: context
|
||||||
integer*8 , intent(in) :: elec_num
|
integer (c_int64_t) , intent(in) , value :: elec_num
|
||||||
integer*8 , intent(in) :: nucl_num
|
integer (c_int64_t) , intent(in) , value :: nucl_num
|
||||||
integer*8 , intent(in) :: type_nucl_num
|
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
||||||
integer*8 , intent(in) :: type_nucl_vector(nucl_num)
|
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
||||||
double precision , intent(in) :: rescale_factor_en(type_nucl_num)
|
real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num)
|
||||||
integer*8 , intent(in) :: walk_num
|
integer (c_int64_t) , intent(in) , value :: walk_num
|
||||||
double precision , intent(in) :: elec_coord(elec_num,walk_num,3)
|
real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
|
||||||
double precision , intent(in) :: nucl_coord(nucl_num,3)
|
real (c_double ) , intent(in) :: nucl_coord(nucl_num,3)
|
||||||
double precision , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
|
real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
|
||||||
|
integer(qmckl_exit_code) :: info
|
||||||
|
|
||||||
integer*8 :: i, k
|
integer*8 :: i, k
|
||||||
double precision :: coord(3)
|
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 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
|
#+end_src
|
||||||
|
|
||||||
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
|
#+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 (
|
qmckl_exit_code qmckl_compute_en_distance_rescaled (
|
||||||
const qmckl_context context,
|
const qmckl_context context,
|
||||||
const int64_t elec_num,
|
const int64_t elec_num,
|
||||||
const int64_t nucl_num,
|
const int64_t nucl_num,
|
||||||
const int64_t type_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 double* rescale_factor_en,
|
||||||
const int64_t walk_num,
|
const int64_t walk_num,
|
||||||
const double* elec_coord,
|
const double* elec_coord,
|
||||||
@ -5216,52 +5206,28 @@ qmckl_exit_code qmckl_compute_en_distance_rescaled (
|
|||||||
double* const en_distance_rescaled );
|
double* const en_distance_rescaled );
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
#+CALL: generate_c_interface(table=qmckl_en_distance_rescaled_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
#+begin_src c :tangle (eval c) :comments org :exports none
|
||||||
|
qmckl_exit_code qmckl_compute_en_distance_rescaled (
|
||||||
#+RESULTS:
|
const qmckl_context context,
|
||||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
const int64_t elec_num,
|
||||||
integer(c_int32_t) function qmckl_compute_en_distance_rescaled &
|
const int64_t nucl_num,
|
||||||
(context, &
|
const int64_t type_nucl_num,
|
||||||
elec_num, &
|
const int64_t* type_nucl_vector,
|
||||||
nucl_num, &
|
const double* rescale_factor_en,
|
||||||
type_nucl_num, &
|
const int64_t walk_num,
|
||||||
type_nucl_vector, &
|
const double* elec_coord,
|
||||||
rescale_factor_en, &
|
const double* nucl_coord,
|
||||||
walk_num, &
|
double* const en_distance_rescaled )
|
||||||
elec_coord, &
|
{
|
||||||
nucl_coord, &
|
#ifdef HAVE_HPC
|
||||||
en_distance_rescaled) &
|
return qmckl_compute_en_distance_rescaled_hpc
|
||||||
bind(C) result(info)
|
#else
|
||||||
|
return qmckl_compute_en_distance_rescaled_doc
|
||||||
use, intrinsic :: iso_c_binding
|
#endif
|
||||||
implicit none
|
(context, elec_num, nucl_num, type_nucl_num, type_nucl_vector,
|
||||||
|
rescale_factor_en, walk_num, elec_coord, nucl_coord, en_distance_rescaled );
|
||||||
integer (c_int64_t) , intent(in) , value :: context
|
}
|
||||||
integer (c_int64_t) , intent(in) , value :: elec_num
|
#+end_src
|
||||||
integer (c_int64_t) , intent(in) , value :: nucl_num
|
|
||||||
integer (c_int64_t) , intent(in) , value :: type_nucl_num
|
|
||||||
integer (c_int64_t) , intent(in) :: type_nucl_vector(nucl_num)
|
|
||||||
real (c_double ) , intent(in) :: rescale_factor_en(type_nucl_num)
|
|
||||||
integer (c_int64_t) , intent(in) , value :: walk_num
|
|
||||||
real (c_double ) , intent(in) :: elec_coord(elec_num,walk_num,3)
|
|
||||||
real (c_double ) , intent(in) :: nucl_coord(elec_num,3)
|
|
||||||
real (c_double ) , intent(out) :: en_distance_rescaled(elec_num,nucl_num,walk_num)
|
|
||||||
|
|
||||||
integer(c_int32_t), external :: qmckl_compute_en_distance_rescaled_f
|
|
||||||
info = qmckl_compute_en_distance_rescaled_f &
|
|
||||||
(context, &
|
|
||||||
elec_num, &
|
|
||||||
nucl_num, &
|
|
||||||
type_nucl_num, &
|
|
||||||
type_nucl_vector, &
|
|
||||||
rescale_factor_en, &
|
|
||||||
walk_num, &
|
|
||||||
elec_coord, &
|
|
||||||
nucl_coord, &
|
|
||||||
en_distance_rescaled)
|
|
||||||
|
|
||||||
end function qmckl_compute_en_distance_rescaled
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
**** Test
|
**** 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 (nucl_coord == NULL) return QMCKL_INVALID_ARG_9;
|
||||||
if (en_distance_rescaled_gl == NULL) return QMCKL_INVALID_ARG_10;
|
if (en_distance_rescaled_gl == NULL) return QMCKL_INVALID_ARG_10;
|
||||||
|
|
||||||
|
|
||||||
int64_t sze = elec_num*walk_num;
|
int64_t sze = elec_num*walk_num;
|
||||||
|
|
||||||
qmckl_exit_code result = QMCKL_SUCCESS;
|
qmckl_exit_code result = QMCKL_SUCCESS;
|
||||||
|
@ -76,7 +76,7 @@ cat << EOF > ${qmckl_f}
|
|||||||
!
|
!
|
||||||
!
|
!
|
||||||
!
|
!
|
||||||
module qmckl
|
module qmckl_constants
|
||||||
use, intrinsic :: iso_c_binding
|
use, intrinsic :: iso_c_binding
|
||||||
EOF
|
EOF
|
||||||
|
|
||||||
@ -85,6 +85,14 @@ do
|
|||||||
cat $i >> ${qmckl_f}
|
cat $i >> ${qmckl_f}
|
||||||
done
|
done
|
||||||
|
|
||||||
|
cat << EOF >> ${qmckl_f}
|
||||||
|
end module qmckl_constants
|
||||||
|
|
||||||
|
module qmckl
|
||||||
|
use, intrinsic :: iso_c_binding
|
||||||
|
use qmckl_constants
|
||||||
|
EOF
|
||||||
|
|
||||||
for i in ${HEADERS}
|
for i in ${HEADERS}
|
||||||
do
|
do
|
||||||
cat $i >> ${qmckl_f}
|
cat $i >> ${qmckl_f}
|
||||||
|
Loading…
Reference in New Issue
Block a user