diff --git a/org/qmckl_ao.org b/org/qmckl_ao.org index 36d9f6e..10fefa7 100644 --- a/org/qmckl_ao.org +++ b/org/qmckl_ao.org @@ -3346,15 +3346,18 @@ qmckl_ao_gaussian_vgl(const qmckl_context context, #+end_src #+begin_src f90 :tangle (eval f) -integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) - use qmckl +function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + use qmckl_constants implicit none - integer*8 , intent(in) :: context - double precision , intent(in) :: X(3), R(3) - integer*8 , intent(in) :: n - double precision , intent(in) :: A(n) - double precision , intent(out) :: VGL(ldv,5) - integer*8 , intent(in) :: ldv + integer (qmckl_context) , intent(in) , value :: context + real (c_double) , intent(in) :: X(3), R(3) + integer (c_int64_t) , intent(in) , value :: n + real (c_double) , intent(in) :: A(n) + real (c_double) , intent(out) :: VGL(ldv,5) + integer (c_int64_t) , intent(in) , value :: ldv + integer (qmckl_exit_code) :: info integer*8 :: i,j double precision :: Y(3), r2, t, u, v @@ -3405,36 +3408,21 @@ integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(i VGL(i,5) = (t * A(i) - 6.d0) * VGL(i,5) end do -end function qmckl_ao_gaussian_vgl_f - #+end_src - - #+begin_src f90 :tangle (eval f) :exports none -integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & - bind(C) result(info) - use, intrinsic :: iso_c_binding - implicit none - integer (c_int64_t) , intent(in) , value :: context - real (c_double) , intent(in) :: X(3), R(3) - integer (c_int64_t) , intent(in) , value :: n - real (c_double) , intent(in) :: A(n) - real (c_double) , intent(out) :: VGL(ldv,5) - integer (c_int64_t) , intent(in) , value :: ldv - - integer, external :: qmckl_ao_gaussian_vgl_f - info = qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) end function qmckl_ao_gaussian_vgl #+end_src #+begin_src f90 :tangle (eval fh_func) :exports none interface - integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, & - X, R, n, A, VGL, ldv) bind(C) + function qmckl_ao_gaussian_vgl(context, & + X, R, n, A, VGL, ldv) bind(C) result(info) use, intrinsic :: iso_c_binding - integer (c_int64_t) , intent(in) , value :: context + use qmckl_constants + integer (qmckl_context) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: ldv integer (c_int64_t) , intent(in) , value :: n real (c_double) , intent(in) :: X(3), R(3), A(n) real (c_double) , intent(out) :: VGL(ldv,5) + integer(qmckl_exit_code) :: info end function qmckl_ao_gaussian_vgl end interface #+end_src @@ -3442,11 +3430,12 @@ end function qmckl_ao_gaussian_vgl *** Test :noexport: #+begin_src f90 :tangle (eval f_test) -integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) +function test_qmckl_ao_gaussian_vgl(context) bind(C) use qmckl implicit none - integer(c_int64_t), intent(in), value :: context + integer(qmckl_context), intent(in), value :: context + integer(qmckl_exit_code) :: test_qmckl_ao_gaussian_vgl integer*8 :: n, ldv, j, i double precision :: X(3), R(3), Y(3), r2, z @@ -3558,7 +3547,7 @@ assert(0 == test_qmckl_ao_gaussian_vgl(context)); | ~prim_num~ | ~int64_t~ | in | Number of primitives | | ~point_num~ | ~int64_t~ | in | Number of points considered | | ~nucl_num~ | ~int64_t~ | in | Number of nuclei | - | ~nucleus_prim_index~ | ~int64_t[nucl_num]~ | in | Index of the 1st primitive of each nucleus | + | ~nucleus_prim_index~ | ~int64_t[nucl_num+1]~ | in | Index of the 1st primitive of each nucleus | | ~coord~ | ~double[3][point_num]~ | in | Coordinates | | ~nucl_coord~ | ~double[3][nucl_num]~ | in | Nuclear coordinates | | ~expo~ | ~double[prim_num]~ | in | Exponents of the primitives | @@ -3577,28 +3566,29 @@ assert(0 == test_qmckl_ao_gaussian_vgl(context)); const double* coord, const double* nucl_coord, const double* expo, - double* const primitive_vgl ); + double* const primitive_vgl ); #+end_src #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( & - context, prim_num, point_num, nucl_num, & - nucleus_prim_index, coord, nucl_coord, & - expo, primitive_vgl) & - result(info) +function qmckl_compute_ao_basis_primitive_gaussian_vgl & + (context, prim_num, point_num, nucl_num, nucleus_prim_index, coord, nucl_coord, expo, primitive_vgl) & + bind(C) result(info) - use qmckl + use, intrinsic :: iso_c_binding + + use qmckl_constants implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: prim_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: point_num - integer*8 , intent(in) :: nucleus_prim_index(nucl_num+1) - double precision , intent(in) :: coord(point_num,3) - double precision , intent(in) :: nucl_coord(nucl_num,3) - double precision , intent(in) :: expo(prim_num) - double precision , intent(out) :: primitive_vgl(prim_num,5,point_num) + integer (qmckl_context), intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: prim_num + integer (c_int64_t) , intent(in) , value :: point_num + integer (c_int64_t) , intent(in) , value :: nucl_num + integer (c_int64_t) , intent(in) :: nucleus_prim_index(nucl_num+1) + real (c_double ) , intent(in) :: coord(point_num,3) + real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) + real (c_double ) , intent(in) :: expo(prim_num) + real (c_double ) , intent(out) :: primitive_vgl(prim_num,5,point_num) + integer(qmckl_exit_code) :: info integer*8 :: inucl, iprim, ipoint double precision :: x, y, z, two_a, ar2, r2, v, cutoff @@ -3633,52 +3623,9 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f( & end do end do -end function qmckl_compute_ao_basis_primitive_gaussian_vgl_f +end function qmckl_compute_ao_basis_primitive_gaussian_vgl #+end_src - #+CALL: generate_c_interface(table=qmckl_ao_basis_primitive_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_primitive_gaussian_vgl")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_ao_basis_primitive_gaussian_vgl & - (context, & - prim_num, & - point_num, & - nucl_num, & - nucleus_prim_index, & - coord, & - nucl_coord, & - expo, & - primitive_vgl) & - 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 :: prim_num - integer (c_int64_t) , intent(in) , value :: point_num - integer (c_int64_t) , intent(in) , value :: nucl_num - integer (c_int64_t) , intent(in) :: nucleus_prim_index(nucl_num) - real (c_double ) , intent(in) :: coord(point_num,3) - real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) - real (c_double ) , intent(in) :: expo(prim_num) - real (c_double ) , intent(out) :: primitive_vgl(prim_num,5,point_num) - - integer(c_int32_t), external :: qmckl_compute_ao_basis_primitive_gaussian_vgl_f - info = qmckl_compute_ao_basis_primitive_gaussian_vgl_f & - (context, & - prim_num, & - point_num, & - nucl_num, & - nucleus_prim_index, & - coord, & - nucl_coord, & - expo, & - primitive_vgl) - - end function qmckl_compute_ao_basis_primitive_gaussian_vgl - #+end_src *** Provide :noexport: @@ -3920,33 +3867,37 @@ print ( "[7][4][26] : %e"% lf(a,x,y)) const double* nucl_coord, const double* expo, const double* coef_normalized, - double* const shell_vgl ); + double* const shell_vgl ); #+end_src #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( & +function qmckl_compute_ao_basis_shell_gaussian_vgl( & context, prim_num, shell_num, point_num, nucl_num, & nucleus_shell_num, nucleus_index, nucleus_range, & shell_prim_index, shell_prim_num, coord, nucl_coord, & expo, coef_normalized, shell_vgl) & - result(info) - use qmckl + bind(C) result(info) + + use, intrinsic :: iso_c_binding + use qmckl_constants + implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: prim_num - integer*8 , intent(in) :: shell_num - integer*8 , intent(in) :: nucl_num - integer*8 , intent(in) :: point_num - integer*8 , intent(in) :: nucleus_shell_num(nucl_num) - integer*8 , intent(in) :: nucleus_index(nucl_num) - double precision , intent(in) :: nucleus_range(nucl_num) - integer*8 , intent(in) :: shell_prim_index(shell_num) - integer*8 , intent(in) :: shell_prim_num(shell_num) - double precision , intent(in) :: coord(point_num,3) - double precision , intent(in) :: nucl_coord(nucl_num,3) - double precision , intent(in) :: expo(prim_num) - double precision , intent(in) :: coef_normalized(prim_num) - double precision , intent(out) :: shell_vgl(shell_num,5,point_num) + integer (qmckl_context), intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: prim_num + integer (c_int64_t) , intent(in) , value :: shell_num + integer (c_int64_t) , intent(in) , value :: point_num + integer (c_int64_t) , intent(in) , value :: nucl_num + integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) + integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) + real (c_double ) , intent(in) :: nucleus_range(nucl_num) + integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num) + integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num) + real (c_double ) , intent(in) :: coord(point_num,3) + real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) + real (c_double ) , intent(in) :: expo(prim_num) + real (c_double ) , intent(in) :: coef_normalized(prim_num) + real (c_double ) , intent(out) :: shell_vgl(shell_num,5,point_num) + integer(qmckl_exit_code) :: info integer*8 :: inucl, iprim, ipoint, ishell integer*8 :: ishell_start, ishell_end @@ -4020,70 +3971,9 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f( & end do -end function qmckl_compute_ao_basis_shell_gaussian_vgl_f +end function qmckl_compute_ao_basis_shell_gaussian_vgl #+end_src - #+CALL: generate_c_interface(table=qmckl_ao_basis_shell_gaussian_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_basis_shell_gaussian_vgl")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_ao_basis_shell_gaussian_vgl & - (context, & - prim_num, & - shell_num, & - point_num, & - nucl_num, & - nucleus_shell_num, & - nucleus_index, & - nucleus_range, & - shell_prim_index, & - shell_prim_num, & - coord, & - nucl_coord, & - expo, & - coef_normalized, & - shell_vgl) & - 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 :: prim_num - integer (c_int64_t) , intent(in) , value :: shell_num - integer (c_int64_t) , intent(in) , value :: point_num - integer (c_int64_t) , intent(in) , value :: nucl_num - integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) - integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) - real (c_double ) , intent(in) :: nucleus_range(nucl_num) - integer (c_int64_t) , intent(in) :: shell_prim_index(shell_num) - integer (c_int64_t) , intent(in) :: shell_prim_num(shell_num) - real (c_double ) , intent(in) :: coord(point_num,3) - real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) - real (c_double ) , intent(in) :: expo(prim_num) - real (c_double ) , intent(in) :: coef_normalized(prim_num) - real (c_double ) , intent(out) :: shell_vgl(shell_num,5,point_num) - - integer(c_int32_t), external :: qmckl_compute_ao_basis_shell_gaussian_vgl_f - info = qmckl_compute_ao_basis_shell_gaussian_vgl_f & - (context, & - prim_num, & - shell_num, & - point_num, & - nucl_num, & - nucleus_shell_num, & - nucleus_index, & - nucleus_range, & - shell_prim_index, & - shell_prim_num, & - coord, & - nucl_coord, & - expo, & - coef_normalized, & - shell_vgl) - - end function qmckl_compute_ao_basis_shell_gaussian_vgl - #+end_src *** Provide :noexport: @@ -4347,21 +4237,26 @@ print ( "[1][4][26] : %25.15e"% lf(a,x,y)) const double* X, const int32_t* LMAX, double* const P, - const int64_t ldp ); + const int64_t ldp ); #+end_src #+begin_src f90 :tangle (eval f) -integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) - use qmckl - implicit none - integer*8 , intent(in) :: context - integer*8 , intent(in) :: n - real*8 , intent(in) :: X(n) - integer , intent(in) :: LMAX(n) - real*8 , intent(out) :: P(ldp,n) - integer*8 , intent(in) :: ldp +function qmckl_ao_power(context, n, X, LMAX, P, ldp) & + bind(C) result(info) + use, intrinsic :: iso_c_binding - integer*8 :: i,k + use qmckl_constants + implicit none + + integer (qmckl_context), intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: n + real (c_double ) , intent(in) :: X(n) + integer (c_int32_t) , intent(in) :: LMAX(n) + real (c_double ) , intent(out) :: P(ldp,n) + integer (c_int64_t) , intent(in) , value :: ldp + + integer(qmckl_exit_code) :: info + integer(c_int64_t) :: i,k info = QMCKL_SUCCESS @@ -4393,7 +4288,7 @@ integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) end do end do -end function qmckl_ao_power_f +end function qmckl_ao_power #+end_src #+CALL: generate_f_interface(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power") @@ -4401,14 +4296,14 @@ end function qmckl_ao_power_f #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_ao_power & + integer(qmckl_exit_code) function qmckl_ao_power & (context, n, X, LMAX, P, ldp) & bind(C) use, intrinsic :: iso_c_binding import implicit none - integer (c_int64_t) , intent(in) , value :: context + integer (qmckl_context), intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: n real (c_double ) , intent(in) :: X(n) integer (c_int32_t) , intent(in) :: LMAX(n) @@ -4419,39 +4314,15 @@ end function qmckl_ao_power_f end interface #+end_src - #+CALL: generate_c_interface(table=qmckl_ao_power_args,rettyp=get_value("CRetType"),fname="qmckl_ao_power") - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_ao_power & - (context, n, X, LMAX, P, ldp) & - 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 :: n - real (c_double ) , intent(in) :: X(n) - integer (c_int32_t) , intent(in) :: LMAX(n) - real (c_double ) , intent(out) :: P(ldp,n) - integer (c_int64_t) , intent(in) , value :: ldp - - integer(c_int32_t), external :: qmckl_ao_power_f - info = qmckl_ao_power_f & - (context, n, X, LMAX, P, ldp) - - end function qmckl_ao_power - #+end_src - *** Test :noexport: #+begin_src f90 :tangle (eval f_test) -integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) +function test_qmckl_ao_power(context) bind(C) use qmckl implicit none integer(qmckl_context), intent(in), value :: context + integer(qmckl_exit_code) :: test_qmckl_ao_power integer*8 :: n, LDP integer, allocatable :: LMAX(:) @@ -4581,7 +4452,7 @@ assert(0 == test_qmckl_ao_power(context)); int32_t* const L, const int64_t ldl, double* const VGL, - const int64_t ldv ); + const int64_t ldv ); #+end_src #+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_vgl_doc") @@ -4597,7 +4468,7 @@ assert(0 == test_qmckl_ao_power(context)); int32_t* const L, const int64_t ldl, double* const VGL, - const int64_t ldv ); + const int64_t ldv ); #+end_src #+begin_src c :tangle (eval c) :comments org @@ -4614,26 +4485,33 @@ qmckl_ao_polynomial_vgl (const qmckl_context context, { #ifdef HAVE_HPC //return qmckl_ao_polynomial_vgl_hpc (context, X, R, lmax, n, L, ldl, VGL, ldv); - return qmckl_ao_polynomial_vgl_doc (context, X, R, lmax, n, L, ldl, VGL, ldv); + return qmckl_ao_polynomial_vgl_doc #else - return qmckl_ao_polynomial_vgl_doc (context, X, R, lmax, n, L, ldl, VGL, ldv); + return qmckl_ao_polynomial_vgl_doc #endif + (context, X, R, lmax, n, L, ldl, VGL, ldv); } #+end_src #+begin_src f90 :tangle (eval f) -integer function qmckl_ao_polynomial_vgl_doc_f (context, & - X, R, lmax, n, L, ldl, VGL, ldv) result(info) - use qmckl +function qmckl_ao_polynomial_vgl_doc (context, & + X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + use qmckl_constants implicit none - integer*8, intent(in) :: context - double precision, intent(in) :: X(3), R(3) - integer, intent(in) :: lmax - integer*8, intent(out) :: n - integer, intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer*8, intent(in) :: ldl - double precision, intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer*8, intent(in) :: ldv + + integer (qmckl_context), intent(in) , value :: context + real (c_double ) , intent(in) :: X(3) + real (c_double ) , intent(in) :: R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(inout) :: n + integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double ) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer (c_int64_t) , intent(in) , value :: ldv + + integer(qmckl_exit_code) :: info integer*8 :: i,j integer :: a,b,c,d @@ -4747,35 +4625,7 @@ integer function qmckl_ao_polynomial_vgl_doc_f (context, & info = QMCKL_SUCCESS -end function qmckl_ao_polynomial_vgl_doc_f - #+end_src - - #+CALL: generate_c_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_vgl_doc" ) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_ao_polynomial_vgl_doc & - (context, X, R, lmax, n, L, ldl, VGL, ldv) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - real (c_double ) , intent(in) :: X(3) - real (c_double ) , intent(in) :: R(3) - integer (c_int32_t) , intent(in) , value :: lmax - integer (c_int64_t) , intent(inout) :: n - integer (c_int32_t) , intent(out) :: L(ldl,n) - integer (c_int64_t) , intent(in) , value :: ldl - real (c_double ) , intent(out) :: VGL(ldv,n) - integer (c_int64_t) , intent(in) , value :: ldv - - integer(c_int32_t), external :: qmckl_ao_polynomial_vgl_doc_f - info = qmckl_ao_polynomial_vgl_doc_f & - (context, X, R, lmax, n, L, ldl, VGL, ldv) - - end function qmckl_ao_polynomial_vgl_doc +end function qmckl_ao_polynomial_vgl_doc #+end_src #+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("FRetType"),fname="qmckl_ao_polynomial_vgl_doc" ) @@ -4783,14 +4633,14 @@ end function qmckl_ao_polynomial_vgl_doc_f #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_ao_polynomial_vgl_doc & + integer(qmckl_exit_code) function qmckl_ao_polynomial_vgl_doc & (context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) use, intrinsic :: iso_c_binding import implicit none - integer (c_int64_t) , intent(in) , value :: context + integer (qmckl_context), intent(in) , value :: context real (c_double ) , intent(in) :: X(3) real (c_double ) , intent(in) :: R(3) integer (c_int32_t) , intent(in) , value :: lmax @@ -4809,14 +4659,14 @@ end function qmckl_ao_polynomial_vgl_doc_f #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_ao_polynomial_vgl & + integer(qmckl_exit_code) function qmckl_ao_polynomial_vgl & (context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) use, intrinsic :: iso_c_binding import implicit none - integer (c_int64_t) , intent(in) , value :: context + integer (qmckl_context), intent(in) , value :: context real (c_double ) , intent(in) :: X(3) real (c_double ) , intent(in) :: R(3) integer (c_int32_t) , intent(in) , value :: lmax @@ -4843,7 +4693,7 @@ end function qmckl_ao_polynomial_vgl_doc_f int32_t* const L, const int64_t ldl, double* const VGL, - const int64_t ldv ); + const int64_t ldv ); #+end_src #+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_transp_vgl_doc") @@ -4859,7 +4709,7 @@ end function qmckl_ao_polynomial_vgl_doc_f int32_t* const L, const int64_t ldl, double* const VGL, - const int64_t ldv ); + const int64_t ldv ); #+end_src # #+CALL: generate_c_header(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_transp_vgl_hpc") @@ -4891,26 +4741,34 @@ qmckl_ao_polynomial_transp_vgl (const qmckl_context context, const int64_t ldv ) { #ifdef HAVE_HPC - return qmckl_ao_polynomial_transp_vgl_hpc (context, X, R, lmax, n, L, ldl, VGL, ldv); + return qmckl_ao_polynomial_transp_vgl_hpc #else - return qmckl_ao_polynomial_transp_vgl_doc (context, X, R, lmax, n, L, ldl, VGL, ldv); + return qmckl_ao_polynomial_transp_vgl_doc #endif + (context, X, R, lmax, n, L, ldl, VGL, ldv); } #+end_src #+begin_src f90 :tangle (eval f) -integer function qmckl_ao_polynomial_transp_vgl_doc_f (context, & - X, R, lmax, n, L, ldl, VGL, ldv) result(info) - use qmckl +function qmckl_ao_polynomial_transp_vgl_doc (context, & + X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + + use qmckl_constants implicit none - integer*8 , intent(in) :: context - real*8 , intent(in) :: X(3), R(3) - integer , intent(in) :: lmax - integer*8 , intent(out) :: n - integer , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - integer*8 , intent(in) :: ldl - real*8 , intent(out) :: VGL(ldv,5) - integer*8 , intent(in) :: ldv + + integer (qmckl_context), intent(in) , value :: context + real (c_double ) , intent(in) :: X(3) + real (c_double ) , intent(in) :: R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(inout) :: n + integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double ) , intent(out) :: VGL(ldv,5) + integer (c_int64_t) , intent(in) , value :: ldv + + integer(qmckl_exit_code) :: info integer*8 :: i,j integer :: a,b,c,d @@ -5023,7 +4881,7 @@ integer function qmckl_ao_polynomial_transp_vgl_doc_f (context, & info = QMCKL_SUCCESS -end function qmckl_ao_polynomial_transp_vgl_doc_f +end function qmckl_ao_polynomial_transp_vgl_doc #+end_src #+begin_src c :tangle (eval c) :comments org @@ -5319,80 +5177,24 @@ qmckl_ao_polynomial_transp_vgl_hpc (const qmckl_context context, } #+end_src - #+CALL: generate_c_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_ao_polynomial_transp_vgl_doc") - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_ao_polynomial_transp_vgl_doc & - (context, X, R, lmax, n, L, ldl, VGL, ldv) & - bind(C) result(info) - - use, intrinsic :: iso_c_binding - implicit none - - integer (c_int64_t) , intent(in) , value :: context - real (c_double ) , intent(in) :: X(3) - real (c_double ) , intent(in) :: R(3) - integer (c_int32_t) , intent(in) , value :: lmax - integer (c_int64_t) , intent(inout) :: n - integer (c_int32_t) , intent(out) :: L(ldl,n) - integer (c_int64_t) , intent(in) , value :: ldl - real (c_double ) , intent(out) :: VGL(ldv,n) - integer (c_int64_t) , intent(in) , value :: ldv - - integer(c_int32_t), external :: qmckl_ao_polynomial_transp_vgl_doc_f - info = qmckl_ao_polynomial_transp_vgl_doc_f & - (context, X, R, lmax, n, L, ldl, VGL, ldv) - - end function qmckl_ao_polynomial_transp_vgl_doc - #+end_src - - #+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("FRetType"),fname="qmckl_ao_polynomial_transp_vgl_doc") - - #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_ao_polynomial_transp_vgl_doc & + integer(qmckl_exit_code) function qmckl_ao_polynomial_transp_vgl & (context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) use, intrinsic :: iso_c_binding import implicit none - integer (c_int64_t) , intent(in) , value :: context + integer (qmckl_context), intent(in) , value :: context real (c_double ) , intent(in) :: X(3) real (c_double ) , intent(in) :: R(3) integer (c_int32_t) , intent(in) , value :: lmax integer (c_int64_t) , intent(inout) :: n integer (c_int32_t) , intent(out) :: L(ldl,n) integer (c_int64_t) , intent(in) , value :: ldl - real (c_double ) , intent(out) :: VGL(ldv,n) - integer (c_int64_t) , intent(in) , value :: ldv - - end function qmckl_ao_polynomial_transp_vgl_doc - end interface - #+end_src - - #+CALL: generate_f_interface(table=qmckl_ao_polynomial_vgl_args,rettyp=get_value("FRetType"),fname="qmckl_ao_polynomial_transp_vgl") - - #+RESULTS: - #+begin_src f90 :tangle (eval fh_func) :comments org :exports none - interface - integer(c_int32_t) function qmckl_ao_polynomial_transp_vgl & - (context, X, R, lmax, n, L, ldl, VGL, ldv) & - bind(C) - use, intrinsic :: iso_c_binding - import - implicit none - - integer (c_int64_t) , intent(in) , value :: context - real (c_double ) , intent(in) :: X(3) - real (c_double ) , intent(in) :: R(3) - integer (c_int32_t) , intent(in) , value :: lmax - integer (c_int64_t) , intent(inout) :: n - integer (c_int32_t) , intent(out) :: L(ldl,n) - integer (c_int64_t) , intent(in) , value :: ldl - real (c_double ) , intent(out) :: VGL(ldv,n) + real (c_double ) , intent(out) :: VGL(ldv,5) integer (c_int64_t) , intent(in) , value :: ldv end function qmckl_ao_polynomial_transp_vgl @@ -5402,11 +5204,11 @@ qmckl_ao_polynomial_transp_vgl_hpc (const qmckl_context context, *** Test :noexport: #+begin_src f90 :tangle (eval f_test) -integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) +function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl implicit none - integer(c_int64_t), intent(in), value :: context + integer(qmckl_context), intent(in), value :: context integer :: lmax, d, i integer, allocatable :: L(:,:) @@ -5415,6 +5217,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) double precision, allocatable :: VGL(:,:) double precision :: w double precision :: epsilon + integer(qmckl_exit_code) :: test_qmckl_ao_polynomial_vgl epsilon = qmckl_get_numprec_epsilon(context) @@ -5565,29 +5368,33 @@ for (int32_t ldl=3 ; ldl<=5 ; ++ldl) { | ~ao_value~ | ~double[point_num][ao_num]~ | out | Values of the AOs | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_ao_value_doc_f(context, & +function qmckl_compute_ao_value_doc(context, & ao_num, shell_num, point_num, nucl_num, & coord, nucl_coord, nucleus_index, nucleus_shell_num, & nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & ao_factor, shell_vgl, ao_value) & - result(info) - use qmckl + bind(C) result(info) + use, intrinsic :: iso_c_binding + use qmckl_constants + use qmckl, only: qmckl_ao_polynomial_vgl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: ao_num - integer*8 , intent(in) :: shell_num - integer*8 , intent(in) :: point_num - integer*8 , intent(in) :: nucl_num - double precision , intent(in) :: coord(point_num,3) - double precision , intent(in) :: nucl_coord(nucl_num,3) - integer*8 , intent(in) :: nucleus_index(nucl_num) - integer*8 , intent(in) :: nucleus_shell_num(nucl_num) - double precision , intent(in) :: nucleus_range(nucl_num) - integer , intent(in) :: nucleus_max_ang_mom(nucl_num) - integer , intent(in) :: shell_ang_mom(shell_num) - double precision , intent(in) :: ao_factor(ao_num) - double precision , intent(in) :: shell_vgl(shell_num,5,point_num) - double precision , intent(out) :: ao_value(ao_num,point_num) + integer (qmckl_context), intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: ao_num + integer (c_int64_t) , intent(in) , value :: shell_num + integer (c_int64_t) , intent(in) , value :: point_num + integer (c_int64_t) , intent(in) , value :: nucl_num + real (c_double ) , intent(in) :: coord(point_num,3) + real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) + integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) + integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) + real (c_double ) , intent(in) :: nucleus_range(nucl_num) + integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) + integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) + real (c_double ) , intent(in) :: ao_factor(ao_num) + real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num) + real (c_double ) , intent(out) :: ao_value(ao_num,point_num) + + integer(qmckl_exit_code) :: info double precision :: e_coord(3), n_coord(3) integer*8 :: n_poly @@ -5597,7 +5404,6 @@ integer function qmckl_compute_ao_value_doc_f(context, & integer :: lstart(0:20) double precision :: x, y, z, r2 double precision :: cutoff - integer, external :: qmckl_ao_polynomial_vgl_doc_f double precision, allocatable :: poly_vgl(:,:) integer , allocatable :: powers(:,:), ao_index(:) @@ -5646,7 +5452,7 @@ integer function qmckl_compute_ao_value_doc_f(context, & end if ! Compute polynomials - info = qmckl_ao_polynomial_vgl_doc_f(context, e_coord, n_coord, & + info = qmckl_ao_polynomial_vgl(context, e_coord, n_coord, & nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, & poly_vgl, 5_8) @@ -5667,7 +5473,7 @@ integer function qmckl_compute_ao_value_doc_f(context, & end do deallocate(poly_vgl, powers) -end function qmckl_compute_ao_value_doc_f +end function qmckl_compute_ao_value_doc #+end_src *** HPC version @@ -5994,68 +5800,6 @@ qmckl_compute_ao_value_hpc_gaussian (const qmckl_context context, #endif #+end_src - #+CALL: generate_c_interface(table=qmckl_ao_value_args_doc,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_value_doc")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_ao_value_doc & - (context, & - ao_num, & - shell_num, & - point_num, & - nucl_num, & - coord, & - nucl_coord, & - nucleus_index, & - nucleus_shell_num, & - nucleus_range, & - nucleus_max_ang_mom, & - shell_ang_mom, & - ao_factor, & - shell_vgl, & - ao_value) & - 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 :: ao_num - integer (c_int64_t) , intent(in) , value :: shell_num - integer (c_int64_t) , intent(in) , value :: point_num - integer (c_int64_t) , intent(in) , value :: nucl_num - real (c_double ) , intent(in) :: coord(point_num,3) - real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) - integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) - integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) - real (c_double ) , intent(in) :: nucleus_range(nucl_num) - integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) - integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) - real (c_double ) , intent(in) :: ao_factor(ao_num) - real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num) - real (c_double ) , intent(out) :: ao_value(ao_num,point_num) - - integer(c_int32_t), external :: qmckl_compute_ao_value_doc_f - info = qmckl_compute_ao_value_doc_f & - (context, & - ao_num, & - shell_num, & - point_num, & - nucl_num, & - coord, & - nucl_coord, & - nucleus_index, & - nucleus_shell_num, & - nucleus_range, & - nucleus_max_ang_mom, & - shell_ang_mom, & - ao_factor, & - shell_vgl, & - ao_value) - - end function qmckl_compute_ao_value_doc - #+end_src - **** Provide :noexport: #+CALL: write_provider_header( group="ao_basis", data="ao_value" ) @@ -6369,29 +6113,32 @@ assert( fabs(ao_value[26][224] - ( 7.175045873560788e-10)) < 1.e-14 ); | ~ao_vgl~ | ~double[point_num][5][ao_num]~ | out | Value, gradients and Laplacian of the AOs | #+begin_src f90 :comments org :tangle (eval f) :noweb yes -integer function qmckl_compute_ao_vgl_doc_f(context, & +function qmckl_compute_ao_vgl_doc(context, & ao_num, shell_num, point_num, nucl_num, & coord, nucl_coord, nucleus_index, nucleus_shell_num, & nucleus_range, nucleus_max_ang_mom, shell_ang_mom, & ao_factor, shell_vgl, ao_vgl) & - result(info) - use qmckl + bind(C) result(info) + use, intrinsic :: iso_c_binding + use qmckl_constants + use qmckl, only : qmckl_ao_polynomial_vgl implicit none - integer(qmckl_context), intent(in) :: context - integer*8 , intent(in) :: ao_num - integer*8 , intent(in) :: shell_num - integer*8 , intent(in) :: point_num - integer*8 , intent(in) :: nucl_num - double precision , intent(in) :: coord(point_num,3) - double precision , intent(in) :: nucl_coord(nucl_num,3) - integer*8 , intent(in) :: nucleus_index(nucl_num) - integer*8 , intent(in) :: nucleus_shell_num(nucl_num) - double precision , intent(in) :: nucleus_range(nucl_num) - integer , intent(in) :: nucleus_max_ang_mom(nucl_num) - integer , intent(in) :: shell_ang_mom(shell_num) - double precision , intent(in) :: ao_factor(ao_num) - double precision , intent(in) :: shell_vgl(shell_num,5,point_num) - double precision , intent(out) :: ao_vgl(ao_num,5,point_num) + integer (qmckl_context), intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: ao_num + integer (c_int64_t) , intent(in) , value :: shell_num + integer (c_int64_t) , intent(in) , value :: point_num + integer (c_int64_t) , intent(in) , value :: nucl_num + real (c_double ) , intent(in) :: coord(point_num,3) + real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) + integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) + integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) + real (c_double ) , intent(in) :: nucleus_range(nucl_num) + integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) + integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) + real (c_double ) , intent(in) :: ao_factor(ao_num) + real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num) + real (c_double ) , intent(out) :: ao_vgl(ao_num,5,point_num) + integer(qmckl_exit_code) :: info double precision :: e_coord(3), n_coord(3) integer*8 :: n_poly @@ -6401,7 +6148,6 @@ integer function qmckl_compute_ao_vgl_doc_f(context, & integer :: lstart(0:20) double precision :: x, y, z, r2 double precision :: cutoff - integer, external :: qmckl_ao_polynomial_vgl_doc_f double precision, allocatable :: poly_vgl(:,:) integer , allocatable :: powers(:,:), ao_index(:) @@ -6450,7 +6196,7 @@ integer function qmckl_compute_ao_vgl_doc_f(context, & end if ! Compute polynomials - info = qmckl_ao_polynomial_vgl_doc_f(context, e_coord, n_coord, & + info = qmckl_ao_polynomial_vgl(context, e_coord, n_coord, & nucleus_max_ang_mom(inucl), n_poly, powers, 3_8, & poly_vgl, 5_8) @@ -6500,7 +6246,7 @@ integer function qmckl_compute_ao_vgl_doc_f(context, & end do deallocate(poly_vgl, powers) -end function qmckl_compute_ao_vgl_doc_f +end function qmckl_compute_ao_vgl_doc #+end_src *** HPC version @@ -6905,68 +6651,6 @@ qmckl_compute_ao_vgl_hpc_gaussian ( #endif #+end_src - #+CALL: generate_c_interface(table=qmckl_ao_vgl_args_doc,rettyp=get_value("CRetType"),fname="qmckl_compute_ao_vgl_doc")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_compute_ao_vgl_doc & - (context, & - ao_num, & - shell_num, & - point_num, & - nucl_num, & - coord, & - nucl_coord, & - nucleus_index, & - nucleus_shell_num, & - nucleus_range, & - nucleus_max_ang_mom, & - shell_ang_mom, & - ao_factor, & - shell_vgl, & - ao_vgl) & - 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 :: ao_num - integer (c_int64_t) , intent(in) , value :: shell_num - integer (c_int64_t) , intent(in) , value :: point_num - integer (c_int64_t) , intent(in) , value :: nucl_num - real (c_double ) , intent(in) :: coord(point_num,3) - real (c_double ) , intent(in) :: nucl_coord(nucl_num,3) - integer (c_int64_t) , intent(in) :: nucleus_index(nucl_num) - integer (c_int64_t) , intent(in) :: nucleus_shell_num(nucl_num) - real (c_double ) , intent(in) :: nucleus_range(nucl_num) - integer (c_int32_t) , intent(in) :: nucleus_max_ang_mom(nucl_num) - integer (c_int32_t) , intent(in) :: shell_ang_mom(shell_num) - real (c_double ) , intent(in) :: ao_factor(ao_num) - real (c_double ) , intent(in) :: shell_vgl(shell_num,5,point_num) - real (c_double ) , intent(out) :: ao_vgl(ao_num,5,point_num) - - integer(c_int32_t), external :: qmckl_compute_ao_vgl_doc_f - info = qmckl_compute_ao_vgl_doc_f & - (context, & - ao_num, & - shell_num, & - point_num, & - nucl_num, & - coord, & - nucl_coord, & - nucleus_index, & - nucleus_shell_num, & - nucleus_range, & - nucleus_max_ang_mom, & - shell_ang_mom, & - ao_factor, & - shell_vgl, & - ao_vgl) - - end function qmckl_compute_ao_vgl_doc - #+end_src - **** Provide :noexport: #+CALL: write_provider_header( group="ao_basis", data="ao_vgl" ) diff --git a/org/qmckl_distance.org b/org/qmckl_distance.org index 46e9373..5f120ae 100644 --- a/org/qmckl_distance.org +++ b/org/qmckl_distance.org @@ -86,7 +86,7 @@ int main() { const double* B, const int64_t ldb, double* const C, - const int64_t ldc ); + const int64_t ldc ); #+end_src #+begin_src f90 :tangle (eval f) @@ -231,21 +231,21 @@ end function qmckl_distance_sq This function is more efficient when ~A~ and ~B~ are transposed. - #+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,fname=get_value("Name")) #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_distance_sq & + integer(qmckl_exit_code) function qmckl_distance_sq & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) use, intrinsic :: iso_c_binding import 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 (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,*) @@ -462,25 +462,29 @@ end function test_qmckl_distance_sq const double* B, const int64_t ldb, double* const C, - const int64_t ldc ); + const int64_t ldc ); #+end_src *** Source #+begin_src f90 :tangle (eval f) -integer function qmckl_distance_f(context, transa, transb, m, n, & +function qmckl_distance(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 @@ -605,60 +609,24 @@ integer function qmckl_distance_f(context, transa, transb, m, n, & end select -end function qmckl_distance_f +end function qmckl_distance #+end_src -*** Performance - - This function is more efficient when ~A~ and ~B~ are transposed. - -** C interface :noexport: - - #+CALL: generate_c_interface(table=qmckl_distance_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 & - (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_f - info = qmckl_distance_f & - (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) - - end function qmckl_distance - #+end_src - - #+CALL: generate_f_interface(table=qmckl_distance_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+CALL: generate_f_interface(table=qmckl_distance_args,fname="qmckl_distance") #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_distance & + integer(qmckl_exit_code) function qmckl_distance & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc) & bind(C) use, intrinsic :: iso_c_binding import 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 (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,*) @@ -672,6 +640,10 @@ end function qmckl_distance_f end interface #+end_src +*** Performance + + This function is more efficient when ~A~ and ~B~ are transposed. + *** Test :noexport: #+begin_src f90 :tangle (eval f_test) @@ -886,26 +858,30 @@ end function test_qmckl_dist const int64_t ldb, double* const C, const int64_t ldc, - const double rescale_factor_kappa ); + const double rescale_factor_kappa ); #+end_src *** Source #+begin_src f90 :tangle (eval f) -integer function qmckl_distance_rescaled_f(context, transa, transb, m, n, & +function qmckl_distance_rescaled(context, transa, transb, m, n, & A, LDA, B, LDB, C, LDC, rescale_factor_kappa) & - 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,*) - real*8 , intent(in) :: rescale_factor_kappa + 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 + real (c_double ) , intent(in) , value :: rescale_factor_kappa + integer(qmckl_exit_code) :: info integer*8 :: i,j real*8 :: x, y, z, dist, rescale_factor_kappa_inv @@ -1032,7 +1008,7 @@ integer function qmckl_distance_rescaled_f(context, transa, transb, m, n, & end select -end function qmckl_distance_rescaled_f +end function qmckl_distance_rescaled #+end_src *** Performance @@ -1041,52 +1017,21 @@ end function qmckl_distance_rescaled_f ** C interface :noexport: - #+CALL: generate_c_interface(table=qmckl_distance_rescaled_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_rescaled & - (context, transa, transb, m, n, A, lda, B, ldb, C, ldc, rescale_factor_kappa) & - 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 - real (c_double ) , intent(in) , value :: rescale_factor_kappa - - integer(c_int32_t), external :: qmckl_distance_rescaled_f - info = qmckl_distance_rescaled_f & - (context, transa, transb, m, n, A, lda, B, ldb, C, ldc, rescale_factor_kappa) - - end function qmckl_distance_rescaled - #+end_src - - #+CALL: generate_f_interface(table=qmckl_distance_rescaled_args,rettyp=get_value("FRetType"),fname=get_value("Name")) + #+CALL: generate_f_interface(table=qmckl_distance_rescaled_args,fname="qmckl_distance_rescaled") #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_distance_rescaled & + integer(qmckl_exit_code) function qmckl_distance_rescaled & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc, rescale_factor_kappa) & bind(C) use, intrinsic :: iso_c_binding import 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 (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,*) @@ -1345,7 +1290,7 @@ end function test_qmckl_dist_rescaled | ~lda~ | ~int64_t~ | in | Leading dimension of array ~A~ | | ~B~ | ~double[][ldb]~ | in | Array containing the $n \times 3$ matrix $B$ | | ~ldb~ | ~int64_t~ | in | Leading dimension of array ~B~ | - | ~C~ | ~double[4][n][ldc]~ | out | Array containing the $4 \times m \times n$ matrix $C$ | + | ~C~ | ~double[n][ldc][4]~ | out | Array containing the $4 \times m \times n$ matrix $C$ | | ~ldc~ | ~int64_t~ | in | Leading dimension of array ~C~ | | ~rescale_factor_kappa~ | ~double~ | in | Factor for calculating rescaled distances derivatives | @@ -1383,21 +1328,26 @@ end function test_qmckl_dist_rescaled #+end_src #+begin_src f90 :tangle (eval f) -integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, & +function qmckl_distance_rescaled_gl(context, transa, transb, m, n, & A, LDA, B, LDB, C, LDC, rescale_factor_kappa) & - result(info) - use qmckl + bind(C) result(info) + use qmckl_constants + use, intrinsic :: iso_c_binding 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(4,ldc,*) - real*8 , intent(in) :: rescale_factor_kappa + + integer(qmckl_exit_code) :: info + 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(4,ldc,n) + integer (c_int64_t) , intent(in) , value :: ldc + real (c_double ) , intent(in) , value :: rescale_factor_kappa integer*8 :: i,j real*8 :: x, y, z, dist, dist_inv @@ -1483,7 +1433,7 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, & dist = dsqrt(x*x + y*y + z*z) ! Avoid floating-point exception if (dist == 0.d0) then - dist = 69.d0/rescale_factor_kappa + dist = 69.d0/rescale_factor_kappa endif dist_inv = 1.0d0/dist rij = dexp(-rescale_factor_kappa * dist) @@ -1504,7 +1454,7 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, & dist = dsqrt(x*x + y*y + z*z) ! Avoid floating-point exception if (dist == 0.d0) then - dist = 69.d0/rescale_factor_kappa + dist = 69.d0/rescale_factor_kappa endif dist_inv = 1.0d0/dist rij = dexp(-rescale_factor_kappa * dist) @@ -1525,7 +1475,7 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, & dist = dsqrt(x*x + y*y + z*z) ! Avoid floating-point exception if (dist == 0.d0) then - dist = 69.d0/rescale_factor_kappa + dist = 69.d0/rescale_factor_kappa endif dist_inv = 1.0d0/dist rij = dexp(-rescale_factor_kappa * dist) @@ -1546,7 +1496,7 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, & dist = dsqrt(x*x + y*y + z*z) ! Avoid floating-point exception if (dist == 0.d0) then - dist = 69.d0/rescale_factor_kappa + dist = 69.d0/rescale_factor_kappa endif dist_inv = 1.0d0/dist rij = dexp(-rescale_factor_kappa * dist) @@ -1559,64 +1509,34 @@ integer function qmckl_distance_rescaled_gl_f(context, transa, transb, m, n, & end select -end function qmckl_distance_rescaled_gl_f +end function qmckl_distance_rescaled_gl #+end_src This function is more efficient when ~A~ and ~B~ are transposed. - #+CALL: generate_c_interface(table=qmckl_distance_rescaled_gl_args,fname=get_value("Name")) - - #+RESULTS: - #+begin_src f90 :tangle (eval f) :comments org :exports none - integer(c_int32_t) function qmckl_distance_rescaled_gl & - (context, transa, transb, m, n, A, lda, B, ldb, C, ldc, rescale_factor_kappa) & - 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,4) - integer (c_int64_t) , intent(in) , value :: ldc - real (c_double ) , intent(in) , value :: rescale_factor_kappa - - integer(c_int32_t), external :: qmckl_distance_rescaled_gl_f - info = qmckl_distance_rescaled_gl_f & - (context, transa, transb, m, n, A, lda, B, ldb, C, ldc, rescale_factor_kappa) - - end function qmckl_distance_rescaled_gl - #+end_src #+CALL: generate_f_interface(table=qmckl_distance_rescaled_gl_args,rettyp=get_value("FRetType"),fname=get_value("Name")) #+RESULTS: #+begin_src f90 :tangle (eval fh_func) :comments org :exports none interface - integer(c_int32_t) function qmckl_distance_rescaled_gl & + integer(qmckl_exit_code) function qmckl_distance_rescaled_gl & (context, transa, transb, m, n, A, lda, B, ldb, C, ldc, rescale_factor_kappa) & bind(C) use, intrinsic :: iso_c_binding import 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 (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,4) + real (c_double ) , intent(out) :: C(4,ldc,n) integer (c_int64_t) , intent(in) , value :: ldc real (c_double ) , intent(in) , value :: rescale_factor_kappa diff --git a/tools/lib.org b/tools/lib.org index f5ce5eb..f12003d 100644 --- a/tools/lib.org +++ b/tools/lib.org @@ -35,10 +35,10 @@ *** Fortran-C type conversions #+NAME:f_of_c - #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" + #+BEGIN_SRC python :var table=test :var rettyp="qmckl_exit_code" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" f_of_c_d = { '' : '' - , 'qmckl_context' : 'integer (c_int64_t)' - , 'qmckl_exit_code' : 'integer (c_int32_t)' + , 'qmckl_context' : 'integer (qmckl_context)' + , 'qmckl_exit_code' : 'integer (qmckl_exit_code)' , 'bool' : 'logical*8' , 'int32_t' : 'integer (c_int32_t)' , 'int64_t' : 'integer (c_int64_t)' @@ -53,8 +53,8 @@ f_of_c_d = { '' : '' #+NAME:c_of_f #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" ctypeid_d = { '' : '' - , 'qmckl_context' : 'integer(c_int64_t)' - , 'qmckl_exit_code' : 'integer(c_int32_t)' + , 'qmckl_context' : 'integer(qmckl_context)' + , 'qmckl_exit_code' : 'integer(qmckl_exit_code)' , 'integer' : 'integer(c_int32_t)' , 'integer*8' : 'integer(c_int64_t)' , 'real' : 'real(c_float)' @@ -164,7 +164,7 @@ return template *** Generates a C interface to the Fortran function #+NAME: generate_c_interface - #+BEGIN_SRC python :var table=[] :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" + #+BEGIN_SRC python :var table=[] :var rettyp="qmckl_exit_code" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none" <> <> <> @@ -220,7 +220,7 @@ return results *** Generates a Fortran interface to the C function #+NAME: generate_f_interface - #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_func) :comments org :exports none" + #+BEGIN_SRC python :var table=test :var rettyp="qmckl_exit_code" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_func) :comments org :exports none" <> <> <> @@ -269,7 +269,7 @@ return results #+END_SRC #+NAME: generate_private_f_interface - #+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_private_func) :comments org :exports none" + #+BEGIN_SRC python :var table=test :var rettyp="qmckl_exit_code" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_private_func) :comments org :exports none" <> <> <>