mirror of https://github.com/TREX-CoE/qmckl.git
Integration of Verificarlo CI tests (#1)
* comment * Update distance test code The distance test has been updated to the latest version, with a first attempt at using vfc_probes inside it * Functional implementation of vfc_probes in the distance tests This commit has the first functional vfc_ci tests. Verificarlo tests should be written over the existing tests, and they can be enabled with the following configure command: QMCKL_DEVEL=1 ./configure --prefix=$PWD/_install --enable-maintainer-mode --enable-vfc_ci CC="verificarlo-f -Mpreprocess -D VFC_CI" FC="verificarlo-f -Mpreprocess -D VFC_CI" --host=x86_64 The --enable-vfc_ci flag will trigger the linking of the vfc_ci library. Moreover, as of now, the "-Mpreprocess" and "-D VFC_CI" flags have to be specified directly here. There is probably an appropriate macro to place those flags into but I couldn't find it yet, and could only manage to build the tests this way. When the VFC_CI preprocessor is defined, somme additional code to register and export the test probes can be executed (see qmckl_distance.org). As of now, the tests are built as normal, even though they are expected to fail : make all make check From there, the test_qmckl_distance (and potentially the others) executable can be called at will. This will typically be done automatically by vfc_ci, but one could manually execute the executable by defining the following env variables : VFC_PROBES_OUTPUT="test.csv" VFC_BACKENDS="libinterflop_ieee.so" depending on the export file and the Verificarlo backend to be used. The next steps will be to define more tests such as this one, and to integrate them into a Verificarlo CI workflow (by writing a vfc_tests_config.json file and using the automatic CI setup command). * Error in FOrtran interface fixed * Added missing Fortran interfaces * Modify distance test and install process integration All probes are now ignored using only the preprocessor (instead of checking for a facultative argument) in the distance test. Moreover,preprocessing can now be enabled correctly using FCFLAGS (the issue seemed to come from the order of the arguments passed to gfortran/verificarlo-f with the preprocessor arg having to come first). * Add vfc_probes to AO tests vfc_probes have been added to qmckl_ao.org in the same way as qmckl_distance.org, which means that it can be enabled or disabled at compile time using the --enable-vfc_ci option. qmckl_distance.org has been slightly modified with a better indentation, and configure.ac now adds the "-D VFC_CI" flag to CFLAGS when vfc_ci is enabled. Co-authored-by: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
This commit is contained in:
Aurélien Delval
GitHub
parent
e329d0a125
commit
d0eb207404
|
|
@ -13,6 +13,8 @@ config.status
|
|||
config.sub
|
||||
configure
|
||||
generated.mk
|
||||
.vfcwrapper.o
|
||||
libtool
|
||||
m4/libtool.m4
|
||||
m4/ltoptions.m4
|
||||
m4/ltsugar.m4
|
||||
|
|
|
|||
12
Makefile.am
12
Makefile.am
|
|
@ -31,6 +31,12 @@
|
|||
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
|
||||
|
||||
if VFC_CI
|
||||
AM_LDFLAGS=-lvfc_probes -lvfc_probes_f
|
||||
endif
|
||||
|
||||
|
||||
ACLOCAL_AMFLAGS = -I m4
|
||||
|
||||
VERSION_MAJOR = @VERSION_MAJOR@
|
||||
|
|
@ -64,7 +70,7 @@ src_libqmckl_la_SOURCES = $(qmckl_h) $(src_qmckl_f) $(C_FILES) $(F_FILES) $(H_PR
|
|||
|
||||
export qmckl_f qmckl_h srcdir
|
||||
|
||||
CLEANFILES+=$(test_qmckl_f) $(src_qmckl_f) $(test_qmckl_o) $(src_qmckl_o)
|
||||
CLEANFILES+=$(test_qmckl_f) $(src_qmckl_f) $(test_qmckl_o) $(src_qmckl_o)
|
||||
|
||||
htmlize_el=share/doc/qmckl/html/htmlize.el
|
||||
|
||||
|
|
@ -156,13 +162,13 @@ $(htmlize_el):
|
|||
$(srcdir)/tools/install_htmlize.sh $(htmlize_el)
|
||||
|
||||
tests/chbrclf.h: $(qmckl_h)
|
||||
|
||||
|
||||
|
||||
generated.mk: $(ORG_FILES)
|
||||
$(PYTHON) $(srcdir)/tools/build_makefile.py
|
||||
|
||||
cppcheck: cppcheck.out
|
||||
|
||||
|
||||
cppcheck.out: $(qmckl_h)
|
||||
cd src/ && \
|
||||
cppcheck --addon=cert -q --error-exitcode=0 \
|
||||
|
|
|
|||
38
configure.ac
38
configure.ac
|
|
@ -4,24 +4,24 @@
|
|||
# QMCkl - Quantum Monte Carlo kernel library
|
||||
#
|
||||
# BSD 3-Clause License
|
||||
#
|
||||
#
|
||||
# Copyright (c) 2020, TREX Center of Excellence
|
||||
# All rights reserved.
|
||||
#
|
||||
#
|
||||
# Redistribution and use in source and binary forms, with or without
|
||||
# modification, are permitted provided that the following conditions are met:
|
||||
#
|
||||
#
|
||||
# 1. Redistributions of source code must retain the above copyright notice, this
|
||||
# list of conditions and the following disclaimer.
|
||||
#
|
||||
#
|
||||
# 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
# this list of conditions and the following disclaimer in the documentation
|
||||
# and/or other materials provided with the distribution.
|
||||
#
|
||||
#
|
||||
# 3. Neither the name of the copyright holder nor the names of its
|
||||
# contributors may be used to endorse or promote products derived from
|
||||
# this software without specific prior written permission.
|
||||
#
|
||||
#
|
||||
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
|
|
@ -168,7 +168,7 @@ AC_TYPE_UINT64_T
|
|||
# Checks for library functions.
|
||||
|
||||
## qmckl
|
||||
AC_FUNC_MALLOC
|
||||
# AC_FUNC_MALLOC
|
||||
AC_CHECK_FUNCS([memset strerror])
|
||||
|
||||
# Development mode
|
||||
|
|
@ -197,6 +197,29 @@ if test "x${QMCKL_DEVEL}" != "x"; then
|
|||
|
||||
fi
|
||||
|
||||
# Enable Verificarlo tests
|
||||
AC_ARG_ENABLE([vfc_ci],
|
||||
[ --enable-vfc_ci Build the library with vfc_ci support],
|
||||
[case "${enableval}" in
|
||||
yes) vfc_ci=true && FCFLAGS="-D VFC_CI $FCFLAGS" && CFLAGS="-D VFC_CI $CFLAGS";;
|
||||
no) vfc_ci=false ;;
|
||||
*) AC_MSG_ERROR([bad value ${enableval} for --enable_vfc_ci]) ;;
|
||||
esac],[vfc_ci=false])
|
||||
AM_CONDITIONAL([VFC_CI], [test x$vfc_ci = xtrue])
|
||||
|
||||
# Enable Fortran preprocessor
|
||||
if test "$FC" = "gfortran"; then
|
||||
AC_MSG_NOTICE(gfortran detected)
|
||||
# Arguments order is important here
|
||||
FCFLAGS="-cpp $FCFLAGS"
|
||||
fi
|
||||
|
||||
if test "$FC" = "verificarlo-f"; then
|
||||
AC_MSG_NOTICE(verificarlo-f detected)
|
||||
# Arguments order is important here
|
||||
FCFLAGS="-Mpreprocess $FCFLAGS"
|
||||
fi
|
||||
|
||||
#PKG-CONFIG
|
||||
#mkl-dynamic-lp64-seq
|
||||
|
||||
|
|
@ -238,4 +261,3 @@ where the optional <target> is:
|
|||
check - run tests
|
||||
install - install ${PACKAGE_NAME}
|
||||
--------------------------------------------------"
|
||||
|
||||
|
|
|
|||
|
|
@ -30,10 +30,6 @@
|
|||
/* Define to 1 if you have the `pthread' library (-lpthread). */
|
||||
#undef HAVE_LIBPTHREAD
|
||||
|
||||
/* Define to 1 if your system has a GNU libc compatible `malloc' function, and
|
||||
to 0 otherwise. */
|
||||
#undef HAVE_MALLOC
|
||||
|
||||
/* Define to 1 if you have the <malloc.h> header file. */
|
||||
#undef HAVE_MALLOC_H
|
||||
|
||||
|
|
@ -145,9 +141,6 @@
|
|||
such a type exists and the standard includes do not define it. */
|
||||
#undef int64_t
|
||||
|
||||
/* Define to rpl_malloc if the replacement function should be used. */
|
||||
#undef malloc
|
||||
|
||||
/* Define to `unsigned int' if <sys/types.h> does not define. */
|
||||
#undef size_t
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,160 @@
|
|||
/* include/config.h.in. Generated from configure.ac by autoheader. */
|
||||
|
||||
/* Define to turn on debugging checks */
|
||||
#undef DEBUG
|
||||
|
||||
/* Define when using the profiler tool */
|
||||
#undef ENABLE_PROF
|
||||
|
||||
/* Define to 1 if your Fortran compiler doesn't accept -c and -o together. */
|
||||
#undef FC_NO_MINUS_C_MINUS_O
|
||||
|
||||
/* Define to 1 if you have the <assert.h> header file. */
|
||||
#undef HAVE_ASSERT_H
|
||||
|
||||
/* Define to 1 if you have the <dlfcn.h> header file. */
|
||||
#undef HAVE_DLFCN_H
|
||||
|
||||
/* Define to 1 if you have the <errno.h> header file. */
|
||||
#undef HAVE_ERRNO_H
|
||||
|
||||
/* Define to 1 if you have the <inttypes.h> header file. */
|
||||
#undef HAVE_INTTYPES_H
|
||||
|
||||
/* Define to 1 if you have the `efence' library (-lefence). */
|
||||
#undef HAVE_LIBEFENCE
|
||||
|
||||
/* Define to 1 if you have the `m' library (-lm). */
|
||||
#undef HAVE_LIBM
|
||||
|
||||
/* Define to 1 if you have the `pthread' library (-lpthread). */
|
||||
#undef HAVE_LIBPTHREAD
|
||||
|
||||
/* Define to 1 if your system has a GNU libc compatible `malloc' function, and
|
||||
to 0 otherwise. */
|
||||
#undef HAVE_MALLOC
|
||||
|
||||
/* Define to 1 if you have the <malloc.h> header file. */
|
||||
#undef HAVE_MALLOC_H
|
||||
|
||||
/* Define to 1 if you have the <math.h> header file. */
|
||||
#undef HAVE_MATH_H
|
||||
|
||||
/* Define to 1 if you have the <memory.h> header file. */
|
||||
#undef HAVE_MEMORY_H
|
||||
|
||||
/* Define to 1 if you have the `memset' function. */
|
||||
#undef HAVE_MEMSET
|
||||
|
||||
/* Define to 1 if you have the <pthread.h> header file. */
|
||||
#undef HAVE_PTHREAD_H
|
||||
|
||||
/* Define to 1 if you have the <stdbool.h> header file. */
|
||||
#undef HAVE_STDBOOL_H
|
||||
|
||||
/* Define to 1 if you have the <stdint.h> header file. */
|
||||
#undef HAVE_STDINT_H
|
||||
|
||||
/* Define to 1 if you have the <stdio.h> header file. */
|
||||
#undef HAVE_STDIO_H
|
||||
|
||||
/* Define to 1 if you have the <stdlib.h> header file. */
|
||||
#undef HAVE_STDLIB_H
|
||||
|
||||
/* Define to 1 if you have the `strerror' function. */
|
||||
#undef HAVE_STRERROR
|
||||
|
||||
/* Define to 1 if you have the <strings.h> header file. */
|
||||
#undef HAVE_STRINGS_H
|
||||
|
||||
/* Define to 1 if you have the <string.h> header file. */
|
||||
#undef HAVE_STRING_H
|
||||
|
||||
/* Define to 1 if you have the <sys/stat.h> header file. */
|
||||
#undef HAVE_SYS_STAT_H
|
||||
|
||||
/* Define to 1 if you have the <sys/types.h> header file. */
|
||||
#undef HAVE_SYS_TYPES_H
|
||||
|
||||
/* Define to 1 if you have the <unistd.h> header file. */
|
||||
#undef HAVE_UNISTD_H
|
||||
|
||||
/* Define to 1 if the system has the type `_Bool'. */
|
||||
#undef HAVE__BOOL
|
||||
|
||||
/* Define to the sub-directory where libtool stores uninstalled libraries. */
|
||||
#undef LT_OBJDIR
|
||||
|
||||
/* Define to use debugging malloc/free */
|
||||
#undef MALLOC_TRACE
|
||||
|
||||
/* Define to 1 if your C compiler doesn't accept -c and -o together. */
|
||||
#undef NO_MINUS_C_MINUS_O
|
||||
|
||||
/* Name of package */
|
||||
#undef PACKAGE
|
||||
|
||||
/* Define to the address where bug reports for this package should be sent. */
|
||||
#undef PACKAGE_BUGREPORT
|
||||
|
||||
/* Define to the full name of this package. */
|
||||
#undef PACKAGE_NAME
|
||||
|
||||
/* Define to the full name and version of this package. */
|
||||
#undef PACKAGE_STRING
|
||||
|
||||
/* Define to the one symbol short name of this package. */
|
||||
#undef PACKAGE_TARNAME
|
||||
|
||||
/* Define to the home page for this package. */
|
||||
#undef PACKAGE_URL
|
||||
|
||||
/* Define to the version of this package. */
|
||||
#undef PACKAGE_VERSION
|
||||
|
||||
/* major version */
|
||||
#undef QMCKL_VERSION_MAJOR
|
||||
|
||||
/* minor version */
|
||||
#undef QMCKL_VERSION_MINOR
|
||||
|
||||
/* patch version */
|
||||
#undef QMCKL_VERSION_PATCH
|
||||
|
||||
/* Define to 1 if you have the ANSI C header files. */
|
||||
#undef STDC_HEADERS
|
||||
|
||||
/* Version number of package */
|
||||
#undef VERSION
|
||||
|
||||
/* Define for Solaris 2.5.1 so the uint32_t typedef from <sys/synch.h>,
|
||||
<pthread.h>, or <semaphore.h> is not used. If the typedef were allowed, the
|
||||
#define below would cause a syntax error. */
|
||||
#undef _UINT32_T
|
||||
|
||||
/* Define for Solaris 2.5.1 so the uint64_t typedef from <sys/synch.h>,
|
||||
<pthread.h>, or <semaphore.h> is not used. If the typedef were allowed, the
|
||||
#define below would cause a syntax error. */
|
||||
#undef _UINT64_T
|
||||
|
||||
/* Define to the type of a signed integer type of width exactly 32 bits if
|
||||
such a type exists and the standard includes do not define it. */
|
||||
#undef int32_t
|
||||
|
||||
/* Define to the type of a signed integer type of width exactly 64 bits if
|
||||
such a type exists and the standard includes do not define it. */
|
||||
#undef int64_t
|
||||
|
||||
/* Define to rpl_malloc if the replacement function should be used. */
|
||||
#undef malloc
|
||||
|
||||
/* Define to `unsigned int' if <sys/types.h> does not define. */
|
||||
#undef size_t
|
||||
|
||||
/* Define to the type of an unsigned integer type of width exactly 32 bits if
|
||||
such a type exists and the standard includes do not define it. */
|
||||
#undef uint32_t
|
||||
|
||||
/* Define to the type of an unsigned integer type of width exactly 64 bits if
|
||||
such a type exists and the standard includes do not define it. */
|
||||
#undef uint64_t
|
||||
234
org/qmckl_ao.org
234
org/qmckl_ao.org
|
|
@ -60,9 +60,17 @@ gradients and Laplacian of the atomic basis functions.
|
|||
#include <math.h>
|
||||
#include "chbrclf.h"
|
||||
|
||||
#ifdef VFC_CI
|
||||
#include <vfc_probes.h>
|
||||
#endif
|
||||
|
||||
int main() {
|
||||
qmckl_context context;
|
||||
context = qmckl_context_create();
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_probes probes = vfc_init_probes();
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
|
|
@ -107,7 +115,7 @@ int main() {
|
|||
| ~prim_factor~ | ~[prim_num]~ | Normalization factors of the primtives |
|
||||
|
||||
Computed data:
|
||||
|
||||
|
||||
|----------------------+-------------------------------------+-----------------------------------------------------------------------------------------------|
|
||||
| ~nucleus_prim_index~ | ~[nucl_num]~ | Index of the first primitive for each nucleus |
|
||||
| ~primitive_vgl~ | ~[prim_num][5][walk_num][elec_num]~ | Value, gradients, Laplacian of the primitives at electron positions |
|
||||
|
|
@ -202,10 +210,10 @@ typedef struct qmckl_ao_basis_struct {
|
|||
Some values are initialized by default, and are not concerned by
|
||||
this mechanism.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
#+begin_src c :comments org :tangle (eval h_private_func)
|
||||
qmckl_exit_code qmckl_init_ao_basis(qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c)
|
||||
qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) {
|
||||
|
||||
|
|
@ -225,7 +233,7 @@ qmckl_exit_code qmckl_init_ao_basis(qmckl_context context) {
|
|||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
** Access functions
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func) :exports none
|
||||
|
|
@ -1026,16 +1034,16 @@ qmckl_exit_code qmckl_finalize_basis(qmckl_context context) {
|
|||
ctx->ao_basis.nucleus_prim_index[i] = ctx->ao_basis.shell_prim_index[shell_idx];
|
||||
}
|
||||
ctx->ao_basis.nucleus_prim_index[nucl_num] = ctx->ao_basis.prim_num;
|
||||
|
||||
|
||||
|
||||
/* TODO : sort the basis set here */
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
** Fortran interfaces
|
||||
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_type (context, t) &
|
||||
bind(C)
|
||||
|
|
@ -1087,7 +1095,7 @@ interface
|
|||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_shell_ang_mom(context,shell_ang_mom) &
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_shell_ang_mom(context,shell_ang_mom) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
|
|
@ -1097,7 +1105,7 @@ interface
|
|||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_shell_prim_num(context,shell_prim_num) &
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_shell_prim_num(context,shell_prim_num) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
|
|
@ -1107,7 +1115,7 @@ interface
|
|||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_shell_prim_index(context,shell_prim_index) &
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_shell_prim_index(context,shell_prim_index) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
|
|
@ -1117,7 +1125,7 @@ interface
|
|||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_shell_factor(context,shell_factor) &
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_shell_factor(context,shell_factor) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
|
|
@ -1127,7 +1135,7 @@ interface
|
|||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_exponent(context,exponent) &
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_exponent(context,exponent) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
|
|
@ -1137,7 +1145,7 @@ interface
|
|||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_coefficient(context,coefficient) &
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_coefficient(context,coefficient) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
|
|
@ -1147,7 +1155,7 @@ interface
|
|||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_nucleus_prim_factor(context,prim_factor) &
|
||||
integer(c_int32_t) function qmckl_set_ao_basis_prim_factor(context,prim_factor) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
|
|
@ -1243,7 +1251,7 @@ assert(rc == QMCKL_SUCCESS);
|
|||
assert(qmckl_ao_basis_provided(context));
|
||||
|
||||
#+end_src
|
||||
|
||||
|
||||
* Radial part
|
||||
** General functions for Gaussian basis functions
|
||||
|
||||
|
|
@ -1385,12 +1393,27 @@ end function qmckl_ao_gaussian_vgl
|
|||
|
||||
# Test
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
#ifdef VFC_CI
|
||||
integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context, probes) bind(C)
|
||||
#else
|
||||
integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C)
|
||||
#endif
|
||||
use qmckl
|
||||
|
||||
#ifdef VFC_CI
|
||||
use iso_c_binding
|
||||
use vfc_probes_f
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
integer(c_int64_t), intent(in), value :: context
|
||||
|
||||
#ifdef VFC_CI
|
||||
type(vfc_probes) :: probes
|
||||
integer(C_INT) :: vfc_err
|
||||
#endif
|
||||
|
||||
integer*8 :: n, ldv, j, i
|
||||
double precision :: X(3), R(3), Y(3), r2
|
||||
double precision, allocatable :: VGL(:,:), A(:)
|
||||
|
|
@ -1414,10 +1437,17 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C)
|
|||
|
||||
test_qmckl_ao_gaussian_vgl = &
|
||||
qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv)
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "ao"//C_NULL_CHAR, "gaussian_vgl"//C_NULL_CHAR, &
|
||||
DBLE(test_qmckl_ao_gaussian_vgl))
|
||||
#else
|
||||
if (test_qmckl_ao_gaussian_vgl /= 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_ao_gaussian_vgl = -1
|
||||
|
||||
#ifndef VFC_CI
|
||||
do i=1,n
|
||||
test_qmckl_ao_gaussian_vgl = -11
|
||||
if (dabs(1.d0 - VGL(i,1) / (&
|
||||
|
|
@ -1444,6 +1474,7 @@ integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C)
|
|||
A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) &
|
||||
)) > epsilon ) return
|
||||
end do
|
||||
#endif
|
||||
|
||||
test_qmckl_ao_gaussian_vgl = 0
|
||||
|
||||
|
|
@ -1452,8 +1483,13 @@ end function test_qmckl_ao_gaussian_vgl
|
|||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :exports none
|
||||
#ifdef VFC_CI
|
||||
int test_qmckl_ao_gaussian_vgl(qmckl_context context, vfc_probes * probes);
|
||||
assert(0 == test_qmckl_ao_gaussian_vgl(context, &probes));
|
||||
#else
|
||||
int test_qmckl_ao_gaussian_vgl(qmckl_context context);
|
||||
assert(0 == test_qmckl_ao_gaussian_vgl(context));
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
** TODO General functions for Slater basis functions
|
||||
|
|
@ -1468,7 +1504,7 @@ qmckl_exit_code qmckl_get_ao_basis_primitive_vgl(qmckl_context context, double*
|
|||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_get_ao_basis_primitive_vgl(qmckl_context context, double* const primitive_vgl) {
|
||||
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
|
|
@ -1511,7 +1547,7 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
|
|||
"qmckl_ao_basis_primitive_vgl",
|
||||
NULL);
|
||||
}
|
||||
|
||||
|
||||
/* Compute if necessary */
|
||||
if (ctx->electron.coord_new_date > ctx->ao_basis.primitive_vgl_date) {
|
||||
|
||||
|
|
@ -1532,7 +1568,7 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
|
|||
ctx->ao_basis.primitive_vgl = primitive_vgl;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc;
|
||||
qmckl_exit_code rc;
|
||||
if (ctx->ao_basis.type == 'G') {
|
||||
rc = qmckl_compute_ao_basis_primitive_gaussian_vgl(context,
|
||||
ctx->ao_basis.prim_num,
|
||||
|
|
@ -1549,7 +1585,7 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
|
|||
QMCKL_FAILURE,
|
||||
"compute_ao_basis_primitive_vgl",
|
||||
"Not yet implemented");
|
||||
}
|
||||
}
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
|
@ -1579,7 +1615,7 @@ qmckl_exit_code qmckl_provide_ao_basis_primitive_vgl(qmckl_context context)
|
|||
| double | nucl_coord[3][elec_num] | in | Nuclear coordinates |
|
||||
| double | expo[prim_num] | in | Exponents of the primitives |
|
||||
| double | primitive_vgl[prim_num][5][walk_num][elec_num] | out | Value, gradients and Laplacian of the primitives |
|
||||
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
||||
integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f(context, &
|
||||
prim_num, elec_num, nucl_num, walk_num, &
|
||||
|
|
@ -1611,19 +1647,19 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f(context, &
|
|||
do iprim = nucleus_prim_index(inucl)+1, nucleus_prim_index(inucl+1)
|
||||
do iwalk = 1, walk_num
|
||||
do ielec = 1, elec_num
|
||||
x = elec_coord(ielec,1,iwalk) - nucl_coord(inucl,1)
|
||||
y = elec_coord(ielec,2,iwalk) - nucl_coord(inucl,2)
|
||||
z = elec_coord(ielec,3,iwalk) - nucl_coord(inucl,3)
|
||||
x = elec_coord(ielec,1,iwalk) - nucl_coord(inucl,1)
|
||||
y = elec_coord(ielec,2,iwalk) - nucl_coord(inucl,2)
|
||||
z = elec_coord(ielec,3,iwalk) - nucl_coord(inucl,3)
|
||||
|
||||
r2 = x*x + y*y + z*z
|
||||
ar2 = expo(iprim)*r2
|
||||
if (ar2 > cutoff) cycle
|
||||
|
||||
|
||||
v = dexp(-ar2)
|
||||
two_a = -2.d0 * expo(iprim) * v
|
||||
|
||||
primitive_vgl(ielec, iwalk, 1, iprim) = v
|
||||
primitive_vgl(ielec, iwalk, 2, iprim) = two_a * x
|
||||
primitive_vgl(ielec, iwalk, 2, iprim) = two_a * x
|
||||
primitive_vgl(ielec, iwalk, 3, iprim) = two_a * y
|
||||
primitive_vgl(ielec, iwalk, 4, iprim) = two_a * z
|
||||
primitive_vgl(ielec, iwalk, 5, iprim) = two_a * (3.d0 - 2.d0*ar2)
|
||||
|
|
@ -1632,7 +1668,7 @@ integer function qmckl_compute_ao_basis_primitive_gaussian_vgl_f(context, &
|
|||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
end function qmckl_compute_ao_basis_primitive_gaussian_vgl_f
|
||||
#+end_src
|
||||
|
||||
|
|
@ -1683,7 +1719,7 @@ qmckl_exit_code qmckl_compute_ao_basis_primitive_gaussian_vgl(
|
|||
import numpy as np
|
||||
|
||||
def f(a,x,y):
|
||||
return np.exp( -a*(np.linalg.norm(x-y))**2 )
|
||||
return np.exp( -a*(np.linalg.norm(x-y))**2 )
|
||||
|
||||
def df(a,x,y,n):
|
||||
h0 = 1.e-6
|
||||
|
|
@ -1750,7 +1786,7 @@ int64_t elec_up_num = chbrclf_elec_up_num;
|
|||
int64_t elec_dn_num = chbrclf_elec_dn_num;
|
||||
double* elec_coord = &(chbrclf_elec_coord[0][0][0]);
|
||||
|
||||
rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num);
|
||||
rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num);
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
|
||||
rc = qmckl_set_electron_walk_num (context, walk_num);
|
||||
|
|
@ -1758,7 +1794,7 @@ assert (rc == QMCKL_SUCCESS);
|
|||
|
||||
assert(qmckl_electron_provided(context));
|
||||
|
||||
rc = qmckl_set_electron_coord (context, 'N', elec_coord);
|
||||
rc = qmckl_set_electron_coord (context, 'N', elec_coord);
|
||||
assert(rc == QMCKL_SUCCESS);
|
||||
|
||||
|
||||
|
|
@ -1773,13 +1809,13 @@ assert( fabs(prim_vgl[7][1][0][26] - (-7.5014974095310560E-004)) < 1.e-14 );
|
|||
assert( fabs(prim_vgl[7][2][0][26] - (-3.8250692897610380E-003)) < 1.e-14 );
|
||||
assert( fabs(prim_vgl[7][3][0][26] - ( 3.4950559194080275E-003)) < 1.e-14 );
|
||||
assert( fabs(prim_vgl[7][4][0][26] - ( 2.0392163767356572E-002)) < 1.e-14 );
|
||||
|
||||
|
||||
assert( fabs(prim_vgl[39][0][1][15] - ( 1.0825844173157661E-003)) < 1.e-14 );
|
||||
assert( fabs(prim_vgl[39][1][1][15] - ( 2.3774237611651531E-003)) < 1.e-14 );
|
||||
assert( fabs(prim_vgl[39][2][1][15] - ( 2.1423191526963063E-003)) < 1.e-14 );
|
||||
assert( fabs(prim_vgl[39][3][1][15] - ( 4.3312003523048492E-004)) < 1.e-14 );
|
||||
assert( fabs(prim_vgl[39][4][1][15] - ( 7.5174404780004771E-003)) < 1.e-14 );
|
||||
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -1796,11 +1832,11 @@ k=0;
|
|||
for (m=0 ; m<walk_num ; ++m) {
|
||||
for (j=0 ; j<elec_num ; ++j) {
|
||||
for (i=0 ; i<nucl_num ; ++i) {
|
||||
|
||||
|
||||
r2 = nucl_elec_dist[i][j];
|
||||
|
||||
|
||||
if (r2 < nucl_radius2[i]) {
|
||||
|
||||
|
||||
for (l=0 ; l<prim_num ; ++l) {
|
||||
tmp[k].i = i;
|
||||
tmp[k].j = j;
|
||||
|
|
@ -1828,7 +1864,7 @@ qmckl_exit_code qmckl_get_ao_basis_shell_vgl(qmckl_context context, double* cons
|
|||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_get_ao_basis_shell_vgl(qmckl_context context, double* const shell_vgl) {
|
||||
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
|
|
@ -1848,6 +1884,20 @@ qmckl_exit_code qmckl_get_ao_basis_shell_vgl(qmckl_context context, double* cons
|
|||
}
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_get_ao_basis_shell_vgl (context, shell_vgl) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
double precision, intent(out) :: shell_vgl(*)
|
||||
end function
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
*** Provide
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
||||
|
|
@ -1871,7 +1921,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
|
|||
"qmckl_ao_basis_shell_vgl",
|
||||
NULL);
|
||||
}
|
||||
|
||||
|
||||
/* Compute if necessary */
|
||||
if (ctx->electron.coord_new_date > ctx->ao_basis.shell_vgl_date) {
|
||||
|
||||
|
|
@ -1892,7 +1942,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
|
|||
ctx->ao_basis.shell_vgl = shell_vgl;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc;
|
||||
qmckl_exit_code rc;
|
||||
if (ctx->ao_basis.type == 'G') {
|
||||
rc = qmckl_compute_ao_basis_shell_gaussian_vgl(context,
|
||||
ctx->ao_basis.prim_num,
|
||||
|
|
@ -1914,7 +1964,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
|
|||
QMCKL_FAILURE,
|
||||
"compute_ao_basis_shell_vgl",
|
||||
"Not yet implemented");
|
||||
}
|
||||
}
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
|
@ -1949,7 +1999,7 @@ qmckl_exit_code qmckl_provide_ao_basis_shell_vgl(qmckl_context context)
|
|||
| ~double~ | ~expo[prim_num]~ | in | Exponents of the primitives |
|
||||
| ~double~ | ~coef[prim_num]~ | in | Coefficients of the primitives |
|
||||
| ~double~ | ~shell_vgl[shell_num][5][walk_num][elec_num]~ | out | Value, gradients and Laplacian of the shells |
|
||||
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
||||
integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, &
|
||||
prim_num, shell_num, elec_num, nucl_num, walk_num, &
|
||||
|
|
@ -1978,8 +2028,9 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, &
|
|||
double precision :: x, y, z, two_a, ar2, r2, v, cutoff
|
||||
|
||||
info = QMCKL_SUCCESS
|
||||
|
||||
|
||||
! Don't compute exponentials when the result will be almost zero.
|
||||
! TODO : Use numerical precision here
|
||||
cutoff = -dlog(1.d-15)
|
||||
|
||||
do inucl=1,nucl_num
|
||||
|
|
@ -1991,9 +2042,9 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, &
|
|||
|
||||
shell_vgl(ielec, iwalk, 1:5, ishell) = 0.d0
|
||||
|
||||
x = elec_coord(ielec,1,iwalk) - nucl_coord(inucl,1)
|
||||
y = elec_coord(ielec,2,iwalk) - nucl_coord(inucl,2)
|
||||
z = elec_coord(ielec,3,iwalk) - nucl_coord(inucl,3)
|
||||
x = elec_coord(ielec,1,iwalk) - nucl_coord(inucl,1)
|
||||
y = elec_coord(ielec,2,iwalk) - nucl_coord(inucl,2)
|
||||
z = elec_coord(ielec,3,iwalk) - nucl_coord(inucl,3)
|
||||
|
||||
r2 = x*x + y*y + z*z
|
||||
|
||||
|
|
@ -2006,30 +2057,30 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, &
|
|||
|
||||
v = coef(iprim) * dexp(-ar2)
|
||||
two_a = -2.d0 * expo(iprim) * v
|
||||
|
||||
|
||||
shell_vgl(ielec, iwalk, 1, ishell) = &
|
||||
shell_vgl(ielec, iwalk, 1, ishell) + v
|
||||
|
||||
|
||||
shell_vgl(ielec, iwalk, 2, ishell) = &
|
||||
shell_vgl(ielec, iwalk, 2, ishell) + two_a * x
|
||||
|
||||
shell_vgl(ielec, iwalk, 2, ishell) + two_a * x
|
||||
|
||||
shell_vgl(ielec, iwalk, 3, ishell) = &
|
||||
shell_vgl(ielec, iwalk, 3, ishell) + two_a * y
|
||||
|
||||
shell_vgl(ielec, iwalk, 3, ishell) + two_a * y
|
||||
|
||||
shell_vgl(ielec, iwalk, 4, ishell) = &
|
||||
shell_vgl(ielec, iwalk, 4, ishell) + two_a * z
|
||||
|
||||
shell_vgl(ielec, iwalk, 4, ishell) + two_a * z
|
||||
|
||||
shell_vgl(ielec, iwalk, 5, ishell) = &
|
||||
shell_vgl(ielec, iwalk, 5, ishell) + two_a * (3.d0 - 2.d0*ar2)
|
||||
|
||||
end do
|
||||
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
end function qmckl_compute_ao_basis_shell_gaussian_vgl_f
|
||||
#+end_src
|
||||
|
||||
|
|
@ -2119,7 +2170,7 @@ qmckl_exit_code qmckl_compute_ao_basis_shell_gaussian_vgl(
|
|||
import numpy as np
|
||||
|
||||
def f(a,x,y):
|
||||
return np.sum( [c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] )
|
||||
return np.sum( [c * np.exp( -b*(np.linalg.norm(x-y))**2) for b,c in a] )
|
||||
|
||||
def df(a,x,y,n):
|
||||
h0 = 1.e-6
|
||||
|
|
@ -2203,7 +2254,7 @@ int64_t elec_up_num = chbrclf_elec_up_num;
|
|||
int64_t elec_dn_num = chbrclf_elec_dn_num;
|
||||
double* elec_coord = &(chbrclf_elec_coord[0][0][0]);
|
||||
|
||||
rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num);
|
||||
rc = qmckl_set_electron_num (context, elec_up_num, elec_dn_num);
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
|
||||
rc = qmckl_set_electron_walk_num (context, walk_num);
|
||||
|
|
@ -2211,7 +2262,7 @@ assert (rc == QMCKL_SUCCESS);
|
|||
|
||||
assert(qmckl_electron_provided(context));
|
||||
|
||||
rc = qmckl_set_electron_coord (context, 'N', elec_coord);
|
||||
rc = qmckl_set_electron_coord (context, 'N', elec_coord);
|
||||
assert(rc == QMCKL_SUCCESS);
|
||||
|
||||
|
||||
|
|
@ -2225,7 +2276,7 @@ printf(" shell_vgl[1][1][0][26] %25.15e\n", shell_vgl[1][1][0][26]);
|
|||
printf(" shell_vgl[1][2][0][26] %25.15e\n", shell_vgl[1][2][0][26]);
|
||||
printf(" shell_vgl[1][3][0][26] %25.15e\n", shell_vgl[1][3][0][26]);
|
||||
printf(" shell_vgl[1][4][0][26] %25.15e\n", shell_vgl[1][4][0][26]);
|
||||
|
||||
|
||||
printf(" shell_vgl[14][0][1][15] %25.15e\n", shell_vgl[14][0][1][15]);
|
||||
printf(" shell_vgl[14][1][1][15] %25.15e\n", shell_vgl[14][1][1][15]);
|
||||
printf(" shell_vgl[14][2][1][15] %25.15e\n", shell_vgl[14][2][1][15]);
|
||||
|
|
@ -2237,16 +2288,15 @@ assert( fabs(shell_vgl[1][1][0][26] - ( -2.615250164814435e-02)) < 1.e-14 );
|
|||
assert( fabs(shell_vgl[1][2][0][26] - ( -1.333535498894419e-01)) < 1.e-14 );
|
||||
assert( fabs(shell_vgl[1][3][0][26] - ( 1.218482800201208e-01)) < 1.e-14 );
|
||||
assert( fabs(shell_vgl[1][4][0][26] - ( 3.197054084474042e-02)) < 1.e-14 );
|
||||
|
||||
|
||||
assert( fabs(shell_vgl[14][0][1][15] - ( 4.509748459243634e-02)) < 1.e-14 );
|
||||
assert( fabs(shell_vgl[14][1][1][15] - ( 3.203917730584210e-02)) < 1.e-14 );
|
||||
assert( fabs(shell_vgl[14][2][1][15] - ( 2.887080725789477e-02)) < 1.e-14 );
|
||||
assert( fabs(shell_vgl[14][3][1][15] - ( 5.836910453297223e-03)) < 1.e-14 );
|
||||
assert( fabs(shell_vgl[14][4][1][15] - ( 1.572966698871693e-02)) < 1.e-14 );
|
||||
}
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
* Polynomial part
|
||||
** General functions for Powers of $x-X_i$
|
||||
:PROPERTIES:
|
||||
|
|
@ -2290,7 +2340,7 @@ assert( fabs(shell_vgl[14][4][1][15] - ( 1.572966698871693e-02)) < 1.e-14 );
|
|||
const double* X,
|
||||
const int32_t* LMAX,
|
||||
double* const P,
|
||||
const int64_t ldp );
|
||||
const int64_t ldp );
|
||||
#+end_src
|
||||
|
||||
*** Source
|
||||
|
|
@ -2395,10 +2445,26 @@ end function qmckl_ao_power_f
|
|||
*** Test
|
||||
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
#ifdef VFC_CI
|
||||
integer(c_int32_t) function test_qmckl_ao_power(context, probes) bind(C)
|
||||
#else
|
||||
integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
|
||||
#endif
|
||||
|
||||
use qmckl
|
||||
|
||||
#ifdef VFC_CI
|
||||
use iso_c_binding
|
||||
use vfc_probes_f
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
#ifdef VFC_CI
|
||||
type(vfc_probes) :: probes
|
||||
integer(C_INT) :: vfc_err
|
||||
#endif
|
||||
|
||||
integer(qmckl_context), intent(in), value :: context
|
||||
|
||||
integer*8 :: n, LDP
|
||||
|
|
@ -2420,7 +2486,13 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
|
|||
end do
|
||||
|
||||
test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP)
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "ao"//C_NULL_CHAR, "power"//C_NULL_CHAR, &
|
||||
DBLE(test_qmckl_ao_power))
|
||||
#else
|
||||
if (test_qmckl_ao_power /= QMCKL_SUCCESS) return
|
||||
#endif
|
||||
|
||||
test_qmckl_ao_power = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -2440,8 +2512,13 @@ end function test_qmckl_ao_power
|
|||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :exports none
|
||||
#ifdef VFC_CI
|
||||
int test_qmckl_ao_power(qmckl_context context, vfc_probes * probes);
|
||||
assert(0 == test_qmckl_ao_power(context, &probes));
|
||||
#else
|
||||
int test_qmckl_ao_power(qmckl_context context);
|
||||
assert(0 == test_qmckl_ao_power(context));
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
** General functions for Value, Gradient and Laplacian of a polynomial
|
||||
|
|
@ -2724,12 +2801,27 @@ end function qmckl_ao_polynomial_vgl_f
|
|||
*** Test
|
||||
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
#ifdef VFC_CI
|
||||
integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context, probes) bind(C)
|
||||
#else
|
||||
integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
|
||||
#endif
|
||||
use qmckl
|
||||
|
||||
#ifdef VFC_CI
|
||||
use iso_c_binding
|
||||
use vfc_probes_f
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
integer(c_int64_t), intent(in), value :: context
|
||||
|
||||
#ifdef VFC_CI
|
||||
type(vfc_probes) :: probes
|
||||
integer(C_INT) :: vfc_err
|
||||
#endif
|
||||
|
||||
integer :: lmax, d, i
|
||||
integer, allocatable :: L(:,:)
|
||||
integer*8 :: n, ldl, ldv, j
|
||||
|
|
@ -2755,9 +2847,15 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
|
|||
test_qmckl_ao_polynomial_vgl = &
|
||||
qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv)
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "ao"//C_NULL_CHAR, "polynomial_vgl"//C_NULL_CHAR, &
|
||||
DBLE(test_qmckl_ao_polynomial_vgl))
|
||||
#else
|
||||
if (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return
|
||||
if (n /= d) return
|
||||
#endif
|
||||
|
||||
#ifdef VFC_CI
|
||||
do j=1,n
|
||||
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
|
||||
do i=1,3
|
||||
|
|
@ -2808,6 +2906,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
|
|||
end if
|
||||
if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return
|
||||
end do
|
||||
#endif
|
||||
|
||||
test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS
|
||||
|
||||
|
|
@ -2816,8 +2915,13 @@ end function test_qmckl_ao_polynomial_vgl
|
|||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
#ifdef VFC_CI
|
||||
int test_qmckl_ao_polynomial_vgl(qmckl_context context, vfc_probes * probes);
|
||||
assert(0 == test_qmckl_ao_polynomial_vgl(context, &probes));
|
||||
#else
|
||||
int test_qmckl_ao_polynomial_vgl(qmckl_context context);
|
||||
assert(0 == test_qmckl_ao_polynomial_vgl(context));
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
* Combining radial and polynomial parts
|
||||
|
|
@ -2832,6 +2936,10 @@ end function test_qmckl_ao_polynomial_vgl
|
|||
rc = qmckl_context_destroy(context);
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_dump_probes(&probes);
|
||||
#endif
|
||||
|
||||
return 0;
|
||||
}
|
||||
#+end_src
|
||||
|
|
@ -2865,5 +2973,3 @@ end function test_qmckl_ao_polynomial_vgl
|
|||
|
||||
# -*- mode: org -*-
|
||||
# vim: syntax=c
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -12,13 +12,21 @@ Functions for the computation of distances between particles.
|
|||
#+begin_src c :comments link :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "assert.h"
|
||||
#include <stdio.h>
|
||||
#ifdef HAVE_CONFIG_H
|
||||
#include "config.h"
|
||||
#endif
|
||||
#ifdef VFC_CI
|
||||
#include <vfc_probes.h>
|
||||
#endif
|
||||
int main() {
|
||||
qmckl_context context;
|
||||
context = qmckl_context_create();
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_probes probes = vfc_init_probes();
|
||||
#endif
|
||||
|
||||
#+end_src
|
||||
|
||||
* Squared distance
|
||||
|
|
@ -282,11 +290,28 @@ end function qmckl_distance_sq_f
|
|||
|
||||
*** Test :noexport:
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
#ifdef VFC_CI
|
||||
integer(qmckl_exit_code) function test_qmckl_distance_sq(context, probes) bind(C)
|
||||
#else
|
||||
integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
|
||||
#endif
|
||||
|
||||
use qmckl
|
||||
|
||||
#ifdef VFC_CI
|
||||
use iso_c_binding
|
||||
use vfc_probes_f
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
|
||||
integer(qmckl_context), intent(in), value :: context
|
||||
|
||||
#ifdef VFC_CI
|
||||
type(vfc_probes) :: probes
|
||||
integer(C_INT) :: vfc_err
|
||||
#endif
|
||||
|
||||
double precision, allocatable :: A(:,:), B(:,:), C(:,:)
|
||||
integer*8 :: m, n, LDA, LDB, LDC
|
||||
double precision :: x
|
||||
|
|
@ -298,6 +323,8 @@ integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
|
|||
LDB = n
|
||||
LDC = 5
|
||||
|
||||
print *, "Entering test 1"
|
||||
|
||||
allocate( A(LDA,m), B(LDB,n), C(LDC,n) )
|
||||
|
||||
do j=1,m
|
||||
|
|
@ -314,17 +341,32 @@ integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
|
|||
test_qmckl_distance_sq = &
|
||||
qmckl_distance_sq(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
#ifdef VFC_CI
|
||||
print *, "About to create probe"
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_sq_Xt"//C_NULL_CHAR, DBLE(test_qmckl_distance_sq))
|
||||
print *, "Created probe"
|
||||
#else
|
||||
if (test_qmckl_distance_sq == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_distance_sq = &
|
||||
qmckl_distance_sq(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_sq_tX"//C_NULL_CHAR, DBLE(test_qmckl_distance_sq))
|
||||
#else
|
||||
if (test_qmckl_distance_sq == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_distance_sq = &
|
||||
qmckl_distance_sq(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_distance_sq /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_sq_Tt"//C_NULL_CHAR, DBLE(test_qmckl_distance_sq))
|
||||
#else
|
||||
if (test_qmckl_distance_sq == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_distance_sq = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -333,14 +375,20 @@ integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
|
|||
x = (A(i,1)-B(j,1))**2 + &
|
||||
(A(i,2)-B(j,2))**2 + &
|
||||
(A(i,3)-B(j,3))**2
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
#ifndef VFC_CI
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14) return
|
||||
#endif
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_distance_sq = &
|
||||
qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_distance_sq /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_sq_nT"//C_NULL_CHAR, DBLE(test_qmckl_distance_sq))
|
||||
#else
|
||||
if (test_qmckl_distance_sq == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_distance_sq = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -349,14 +397,20 @@ integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
|
|||
x = (A(1,i)-B(j,1))**2 + &
|
||||
(A(2,i)-B(j,2))**2 + &
|
||||
(A(3,i)-B(j,3))**2
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
#ifndef VFC_CI
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14) return
|
||||
#endif
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_distance_sq = &
|
||||
qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_distance_sq /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_sq_Tn"//C_NULL_CHAR, DBLE(test_qmckl_distance_sq))
|
||||
#else
|
||||
if (test_qmckl_distance_sq == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_distance_sq = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -365,14 +419,20 @@ integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
|
|||
x = (A(i,1)-B(1,j))**2 + &
|
||||
(A(i,2)-B(2,j))**2 + &
|
||||
(A(i,3)-B(3,j))**2
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
#ifndef VFC_CI
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14) return
|
||||
#endif
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_distance_sq = &
|
||||
qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_distance_sq /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_sq_nN"//C_NULL_CHAR, DBLE(test_qmckl_distance_sq))
|
||||
#else
|
||||
if (test_qmckl_distance_sq == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_distance_sq = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -392,8 +452,13 @@ end function test_qmckl_distance_sq
|
|||
#+end_src
|
||||
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
qmckl_exit_code test_qmckl_distance_sq(qmckl_context context);
|
||||
assert(test_qmckl_distance_sq(context) == QMCKL_SUCCESS);
|
||||
#ifdef VFC_CI
|
||||
qmckl_exit_code test_qmckl_distance_sq(qmckl_context context, vfc_probes * probes);
|
||||
assert(test_qmckl_distance_sq(context, &probes) == QMCKL_SUCCESS);
|
||||
#else
|
||||
qmckl_exit_code test_qmckl_distance_sq(qmckl_context context);
|
||||
assert(test_qmckl_distance_sq(context) == QMCKL_SUCCESS);
|
||||
#endif
|
||||
#+end_src
|
||||
* Distance
|
||||
|
||||
|
|
@ -690,10 +755,23 @@ end function qmckl_distance_f
|
|||
|
||||
*** Test :noexport:
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
#ifdef VFC_CI
|
||||
integer(qmckl_exit_code) function test_qmckl_dist(context, probes) bind(C)
|
||||
#else
|
||||
integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
|
||||
#endif
|
||||
use qmckl
|
||||
#ifdef VFC_CI
|
||||
use iso_c_binding
|
||||
use vfc_probes_f
|
||||
#endif
|
||||
implicit none
|
||||
|
||||
integer(qmckl_context), intent(in), value :: context
|
||||
#ifdef VFC_CI
|
||||
type(vfc_probes) :: probes
|
||||
integer(C_INT) :: vfc_err
|
||||
#endif
|
||||
|
||||
double precision, allocatable :: A(:,:), B(:,:), C(:,:)
|
||||
integer*8 :: m, n, LDA, LDB, LDC
|
||||
|
|
@ -721,18 +799,30 @@ integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
|
|||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_Xt"//C_NULL_CHAR, DBLE(test_qmckl_dist))
|
||||
#else
|
||||
if (test_qmckl_dist == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_tX"//C_NULL_CHAR, DBLE(test_qmckl_dist))
|
||||
#else
|
||||
if (test_qmckl_dist == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_Tt"//C_NULL_CHAR, DBLE(test_qmckl_dist))
|
||||
#else
|
||||
if (test_qmckl_dist == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_dist = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -741,14 +831,20 @@ integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
|
|||
x = dsqrt((A(i,1)-B(j,1))**2 + &
|
||||
(A(i,2)-B(j,2))**2 + &
|
||||
(A(i,3)-B(j,3))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
#ifndef VFC_CI
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14) return
|
||||
#endif
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_nT"//C_NULL_CHAR, DBLE(test_qmckl_dist))
|
||||
#else
|
||||
if (test_qmckl_dist == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_dist = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -757,14 +853,20 @@ integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
|
|||
x = dsqrt((A(1,i)-B(j,1))**2 + &
|
||||
(A(2,i)-B(j,2))**2 + &
|
||||
(A(3,i)-B(j,3))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
#ifndef VFC_CI
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14) return
|
||||
#endif
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_Tn"//C_NULL_CHAR, DBLE(test_qmckl_dist))
|
||||
#else
|
||||
if (test_qmckl_dist == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_dist = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -773,14 +875,20 @@ integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
|
|||
x = dsqrt((A(i,1)-B(1,j))**2 + &
|
||||
(A(i,2)-B(2,j))**2 + &
|
||||
(A(i,3)-B(3,j))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
#ifndef VFC_CI
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14) return
|
||||
#endif
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
#ifdef VFC_CI
|
||||
vfc_err = vfc_probe(probes, "distance"//C_NULL_CHAR, &
|
||||
"distance_nN"//C_NULL_CHAR, DBLE(test_qmckl_dist))
|
||||
#else
|
||||
if (test_qmckl_dist == 0) return
|
||||
#endif
|
||||
|
||||
test_qmckl_dist = QMCKL_FAILURE
|
||||
|
||||
|
|
@ -789,7 +897,9 @@ integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
|
|||
x = dsqrt((A(1,i)-B(1,j))**2 + &
|
||||
(A(2,i)-B(2,j))**2 + &
|
||||
(A(3,i)-B(3,j))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
#ifndef VFC_CI
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14) return
|
||||
#endif
|
||||
end do
|
||||
end do
|
||||
|
||||
|
|
@ -800,8 +910,13 @@ end function test_qmckl_dist
|
|||
#+end_src
|
||||
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
qmckl_exit_code test_qmckl_dist(qmckl_context context);
|
||||
assert(test_qmckl_dist(context) == QMCKL_SUCCESS);
|
||||
#ifdef VFC_CI
|
||||
qmckl_exit_code test_qmckl_dist(qmckl_context context, vfc_probes * probes);
|
||||
assert(test_qmckl_dist(context, &probes) == QMCKL_SUCCESS);
|
||||
#else
|
||||
qmckl_exit_code test_qmckl_dist(qmckl_context context);
|
||||
assert(test_qmckl_dist(context) == QMCKL_SUCCESS);
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
* Rescaled Distance
|
||||
|
|
@ -1114,12 +1229,12 @@ end function qmckl_distance_rescaled_f
|
|||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
~qmckl_distance_rescaled_deriv_e~ computes the matrix of the gradient and laplacian of the
|
||||
~qmckl_distance_rescaled_deriv_e~ computes the matrix of the gradient and laplacian of the
|
||||
rescaled distance with respect to the electron coordinates. The derivative is a rank 3 tensor.
|
||||
The first dimension has a dimension of 4 of which the first three coordinates
|
||||
contains the gradient vector and the last index is the laplacian.
|
||||
|
||||
|
||||
|
||||
|
||||
\[
|
||||
C_{ij} = \left( 1 - \exp{-\kappa C_{ij}}\right)/\kappa
|
||||
\]
|
||||
|
|
@ -1130,12 +1245,12 @@ end function qmckl_distance_rescaled_f
|
|||
\nabla (C_{ij}(\mathbf{r}_{ee})) = \left(\frac{\delta C_{ij}(\mathbf{r}_{ee})}{\delta x},\frac{\delta C_{ij}(\mathbf{r}_{ee})}{\delta y},\frac{\delta C_{ij}(\mathbf{r}_{ee})}{\delta z} \right)
|
||||
\]
|
||||
and the laplacian is defined as follows:
|
||||
|
||||
|
||||
\[
|
||||
\triangle (C_{ij}(r_{ee})) = \frac{\delta^2}{\delta x^2} + \frac{\delta^2}{\delta y^2} + \frac{\delta^2}{\delta z^2}
|
||||
\]
|
||||
|
||||
Using the above three formulae, the expression for the gradient and laplacian is
|
||||
Using the above three formulae, the expression for the gradient and laplacian is
|
||||
as follows:
|
||||
|
||||
\[
|
||||
|
|
@ -1463,6 +1578,11 @@ end function qmckl_distance_rescaled_deriv_e_f
|
|||
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
assert (qmckl_context_destroy(context) == QMCKL_SUCCESS);
|
||||
|
||||
#ifdef VFC_CI
|
||||
vfc_dump_probes(&probes);
|
||||
#endif
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -608,6 +608,30 @@ qmckl_set_electron_rescale_factor_en(qmckl_context context,
|
|||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_electron_num(context, alpha, beta) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int64_t) , intent(in) , value :: alpha
|
||||
integer (c_int64_t) , intent(in) , value :: beta
|
||||
end function
|
||||
end interface
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_electron_walk_num(context, walk_num) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
integer (c_int64_t) , intent(in) , value :: walk_num
|
||||
end function
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
The following function sets the electron coordinates of all the
|
||||
|
|
@ -697,6 +721,20 @@ qmckl_set_electron_coord(qmckl_context context, const char transp, const double*
|
|||
}
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval fh_func) :noweb yes
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_set_electron_coord(context, transp, coord) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
character , intent(in) , value :: transp
|
||||
double precision , intent(in) :: coord(*)
|
||||
end function
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
** Test
|
||||
|
||||
#+begin_src python :results output :exports none
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue