From 50fa3aa754c99267e1fcfcc2d8bb442f78e6db18 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 22 Sep 2023 09:33:54 +0200 Subject: [PATCH] Introduced qmckl_constants module --- org/qmckl_distance.org | 63 +++---- org/qmckl_jastrow_champ.org | 337 ++++++++++++++++-------------------- tools/build_qmckl_f.sh | 10 +- 3 files changed, 180 insertions(+), 230 deletions(-) diff --git a/org/qmckl_distance.org b/org/qmckl_distance.org index 9b1a999..46e9373 100644 --- a/org/qmckl_distance.org +++ b/org/qmckl_distance.org @@ -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: diff --git a/org/qmckl_jastrow_champ.org b/org/qmckl_jastrow_champ.org index d123d52..a72672c 100644 --- a/org/qmckl_jastrow_champ.org +++ b/org/qmckl_jastrow_champ.org @@ -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 ${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}