1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-07-03 18:06:07 +02:00

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 2021-07-07 13:42:42 +02:00 committed by GitHub
parent e329d0a125
commit d0eb207404
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
9 changed files with 2446 additions and 117 deletions

2
.gitignore vendored
View File

@ -13,6 +13,8 @@ config.status
config.sub config.sub
configure configure
generated.mk generated.mk
.vfcwrapper.o
libtool
m4/libtool.m4 m4/libtool.m4
m4/ltoptions.m4 m4/ltoptions.m4
m4/ltsugar.m4 m4/ltsugar.m4

View File

@ -31,6 +31,12 @@
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # 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 ACLOCAL_AMFLAGS = -I m4
VERSION_MAJOR = @VERSION_MAJOR@ VERSION_MAJOR = @VERSION_MAJOR@

View File

@ -168,7 +168,7 @@ AC_TYPE_UINT64_T
# Checks for library functions. # Checks for library functions.
## qmckl ## qmckl
AC_FUNC_MALLOC # AC_FUNC_MALLOC
AC_CHECK_FUNCS([memset strerror]) AC_CHECK_FUNCS([memset strerror])
# Development mode # Development mode
@ -197,6 +197,29 @@ if test "x${QMCKL_DEVEL}" != "x"; then
fi 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 #PKG-CONFIG
#mkl-dynamic-lp64-seq #mkl-dynamic-lp64-seq
@ -238,4 +261,3 @@ where the optional <target> is:
check - run tests check - run tests
install - install ${PACKAGE_NAME} install - install ${PACKAGE_NAME}
--------------------------------------------------" --------------------------------------------------"

View File

@ -30,10 +30,6 @@
/* Define to 1 if you have the `pthread' library (-lpthread). */ /* Define to 1 if you have the `pthread' library (-lpthread). */
#undef HAVE_LIBPTHREAD #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. */ /* Define to 1 if you have the <malloc.h> header file. */
#undef HAVE_MALLOC_H #undef HAVE_MALLOC_H
@ -145,9 +141,6 @@
such a type exists and the standard includes do not define it. */ such a type exists and the standard includes do not define it. */
#undef int64_t #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. */ /* Define to `unsigned int' if <sys/types.h> does not define. */
#undef size_t #undef size_t

160
include/config.h.in~ Normal file
View File

@ -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

View File

@ -60,9 +60,17 @@ gradients and Laplacian of the atomic basis functions.
#include <math.h> #include <math.h>
#include "chbrclf.h" #include "chbrclf.h"
#ifdef VFC_CI
#include <vfc_probes.h>
#endif
int main() { int main() {
qmckl_context context; qmckl_context context;
context = qmckl_context_create(); context = qmckl_context_create();
#ifdef VFC_CI
vfc_probes probes = vfc_init_probes();
#endif
#+end_src #+end_src
#+begin_src c :tangle (eval c) #+begin_src c :tangle (eval c)
@ -1087,7 +1095,7 @@ interface
end function end function
end interface end interface
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) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
@ -1097,7 +1105,7 @@ interface
end function end function
end interface end interface
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) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
@ -1107,7 +1115,7 @@ interface
end function end function
end interface end interface
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) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
@ -1117,7 +1125,7 @@ interface
end function end function
end interface end interface
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) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
@ -1127,7 +1135,7 @@ interface
end function end function
end interface end interface
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) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
@ -1137,7 +1145,7 @@ interface
end function end function
end interface end interface
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) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
@ -1147,7 +1155,7 @@ interface
end function end function
end interface end interface
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) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
import import
@ -1385,12 +1393,27 @@ end function qmckl_ao_gaussian_vgl
# Test # Test
#+begin_src f90 :tangle (eval f_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) integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C)
#endif
use qmckl use qmckl
#ifdef VFC_CI
use iso_c_binding
use vfc_probes_f
#endif
implicit none implicit none
integer(c_int64_t), intent(in), value :: context 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 integer*8 :: n, ldv, j, i
double precision :: X(3), R(3), Y(3), r2 double precision :: X(3), R(3), Y(3), r2
double precision, allocatable :: VGL(:,:), A(:) 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 = & test_qmckl_ao_gaussian_vgl = &
qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) 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 if (test_qmckl_ao_gaussian_vgl /= 0) return
#endif
test_qmckl_ao_gaussian_vgl = -1 test_qmckl_ao_gaussian_vgl = -1
#ifndef VFC_CI
do i=1,n do i=1,n
test_qmckl_ao_gaussian_vgl = -11 test_qmckl_ao_gaussian_vgl = -11
if (dabs(1.d0 - VGL(i,1) / (& 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) & A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) &
)) > epsilon ) return )) > epsilon ) return
end do end do
#endif
test_qmckl_ao_gaussian_vgl = 0 test_qmckl_ao_gaussian_vgl = 0
@ -1452,8 +1483,13 @@ end function test_qmckl_ao_gaussian_vgl
#+end_src #+end_src
#+begin_src c :tangle (eval c_test) :exports none #+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); int test_qmckl_ao_gaussian_vgl(qmckl_context context);
assert(0 == test_qmckl_ao_gaussian_vgl(context)); assert(0 == test_qmckl_ao_gaussian_vgl(context));
#endif
#+end_src #+end_src
** TODO General functions for Slater basis functions ** TODO General functions for Slater basis functions
@ -1848,6 +1884,20 @@ qmckl_exit_code qmckl_get_ao_basis_shell_vgl(qmckl_context context, double* cons
} }
#+end_src #+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 *** Provide
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
@ -1980,6 +2030,7 @@ integer function qmckl_compute_ao_basis_shell_gaussian_vgl_f(context, &
info = QMCKL_SUCCESS info = QMCKL_SUCCESS
! Don't compute exponentials when the result will be almost zero. ! Don't compute exponentials when the result will be almost zero.
! TODO : Use numerical precision here
cutoff = -dlog(1.d-15) cutoff = -dlog(1.d-15)
do inucl=1,nucl_num do inucl=1,nucl_num
@ -2246,7 +2297,6 @@ assert( fabs(shell_vgl[14][4][1][15] - ( 1.572966698871693e-02)) < 1.e-14 );
} }
#+end_src #+end_src
* Polynomial part * Polynomial part
** General functions for Powers of $x-X_i$ ** General functions for Powers of $x-X_i$
:PROPERTIES: :PROPERTIES:
@ -2395,10 +2445,26 @@ end function qmckl_ao_power_f
*** Test *** Test
#+begin_src f90 :tangle (eval 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) integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
#endif
use qmckl use qmckl
#ifdef VFC_CI
use iso_c_binding
use vfc_probes_f
#endif
implicit none implicit none
#ifdef VFC_CI
type(vfc_probes) :: probes
integer(C_INT) :: vfc_err
#endif
integer(qmckl_context), intent(in), value :: context integer(qmckl_context), intent(in), value :: context
integer*8 :: n, LDP integer*8 :: n, LDP
@ -2420,7 +2486,13 @@ integer(c_int32_t) function test_qmckl_ao_power(context) bind(C)
end do end do
test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP) 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 if (test_qmckl_ao_power /= QMCKL_SUCCESS) return
#endif
test_qmckl_ao_power = QMCKL_FAILURE test_qmckl_ao_power = QMCKL_FAILURE
@ -2440,8 +2512,13 @@ end function test_qmckl_ao_power
#+end_src #+end_src
#+begin_src c :tangle (eval c_test) :exports none #+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); int test_qmckl_ao_power(qmckl_context context);
assert(0 == test_qmckl_ao_power(context)); assert(0 == test_qmckl_ao_power(context));
#endif
#+end_src #+end_src
** General functions for Value, Gradient and Laplacian of a polynomial ** General functions for Value, Gradient and Laplacian of a polynomial
@ -2724,12 +2801,27 @@ end function qmckl_ao_polynomial_vgl_f
*** Test *** Test
#+begin_src f90 :tangle (eval 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) integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
#endif
use qmckl use qmckl
#ifdef VFC_CI
use iso_c_binding
use vfc_probes_f
#endif
implicit none implicit none
integer(c_int64_t), intent(in), value :: context 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 :: lmax, d, i
integer, allocatable :: L(:,:) integer, allocatable :: L(:,:)
integer*8 :: n, ldl, ldv, j 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 = & test_qmckl_ao_polynomial_vgl = &
qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) 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 (test_qmckl_ao_polynomial_vgl /= QMCKL_SUCCESS) return
if (n /= d) return if (n /= d) return
#endif
#ifdef VFC_CI
do j=1,n do j=1,n
test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE test_qmckl_ao_polynomial_vgl = QMCKL_FAILURE
do i=1,3 do i=1,3
@ -2808,6 +2906,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
end if end if
if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return
end do end do
#endif
test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS test_qmckl_ao_polynomial_vgl = QMCKL_SUCCESS
@ -2816,8 +2915,13 @@ end function test_qmckl_ao_polynomial_vgl
#+end_src #+end_src
#+begin_src c :tangle (eval c_test) #+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); int test_qmckl_ao_polynomial_vgl(qmckl_context context);
assert(0 == test_qmckl_ao_polynomial_vgl(context)); assert(0 == test_qmckl_ao_polynomial_vgl(context));
#endif
#+end_src #+end_src
* Combining radial and polynomial parts * Combining radial and polynomial parts
@ -2832,6 +2936,10 @@ end function test_qmckl_ao_polynomial_vgl
rc = qmckl_context_destroy(context); rc = qmckl_context_destroy(context);
assert (rc == QMCKL_SUCCESS); assert (rc == QMCKL_SUCCESS);
#ifdef VFC_CI
vfc_dump_probes(&probes);
#endif
return 0; return 0;
} }
#+end_src #+end_src
@ -2865,5 +2973,3 @@ end function test_qmckl_ao_polynomial_vgl
# -*- mode: org -*- # -*- mode: org -*-
# vim: syntax=c # vim: syntax=c

View File

@ -12,13 +12,21 @@ Functions for the computation of distances between particles.
#+begin_src c :comments link :tangle (eval c_test) :noweb yes #+begin_src c :comments link :tangle (eval c_test) :noweb yes
#include "qmckl.h" #include "qmckl.h"
#include "assert.h" #include "assert.h"
#include <stdio.h>
#ifdef HAVE_CONFIG_H #ifdef HAVE_CONFIG_H
#include "config.h" #include "config.h"
#endif #endif
#ifdef VFC_CI
#include <vfc_probes.h>
#endif
int main() { int main() {
qmckl_context context; qmckl_context context;
context = qmckl_context_create(); context = qmckl_context_create();
#ifdef VFC_CI
vfc_probes probes = vfc_init_probes();
#endif
#+end_src #+end_src
* Squared distance * Squared distance
@ -282,11 +290,28 @@ end function qmckl_distance_sq_f
*** Test :noexport: *** Test :noexport:
#+begin_src f90 :tangle (eval f_test) #+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) integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
#endif
use qmckl use qmckl
#ifdef VFC_CI
use iso_c_binding
use vfc_probes_f
#endif
implicit none implicit none
integer(qmckl_context), intent(in), value :: context 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(:,:) double precision, allocatable :: A(:,:), B(:,:), C(:,:)
integer*8 :: m, n, LDA, LDB, LDC integer*8 :: m, n, LDA, LDB, LDC
double precision :: x double precision :: x
@ -298,6 +323,8 @@ integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
LDB = n LDB = n
LDC = 5 LDC = 5
print *, "Entering test 1"
allocate( A(LDA,m), B(LDB,n), C(LDC,n) ) allocate( A(LDA,m), B(LDB,n), C(LDC,n) )
do j=1,m do j=1,m
@ -314,17 +341,32 @@ integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
test_qmckl_distance_sq = & test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC) 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 if (test_qmckl_distance_sq == 0) return
#endif
test_qmckl_distance_sq = & test_qmckl_distance_sq = &
qmckl_distance_sq(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC) 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 if (test_qmckl_distance_sq == 0) return
#endif
test_qmckl_distance_sq = & test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance_sq(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_distance_sq /= 0) return 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 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 + & x = (A(i,1)-B(j,1))**2 + &
(A(i,2)-B(j,2))**2 + & (A(i,2)-B(j,2))**2 + &
(A(i,3)-B(j,3))**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
end do end do
test_qmckl_distance_sq = & test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance_sq(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_distance_sq /= 0) return 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 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 + & x = (A(1,i)-B(j,1))**2 + &
(A(2,i)-B(j,2))**2 + & (A(2,i)-B(j,2))**2 + &
(A(3,i)-B(j,3))**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
end do end do
test_qmckl_distance_sq = & test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_distance_sq /= 0) return 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 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 + & x = (A(i,1)-B(1,j))**2 + &
(A(i,2)-B(2,j))**2 + & (A(i,2)-B(2,j))**2 + &
(A(i,3)-B(3,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
end do end do
test_qmckl_distance_sq = & test_qmckl_distance_sq = &
qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_distance_sq /= 0) return 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 test_qmckl_distance_sq = QMCKL_FAILURE
@ -392,8 +452,13 @@ end function test_qmckl_distance_sq
#+end_src #+end_src
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test)
qmckl_exit_code test_qmckl_distance_sq(qmckl_context context); #ifdef VFC_CI
assert(test_qmckl_distance_sq(context) == QMCKL_SUCCESS); 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 #+end_src
* Distance * Distance
@ -690,10 +755,23 @@ end function qmckl_distance_f
*** Test :noexport: *** Test :noexport:
#+begin_src f90 :tangle (eval f_test) #+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) integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
#endif
use qmckl use qmckl
#ifdef VFC_CI
use iso_c_binding
use vfc_probes_f
#endif
implicit none implicit none
integer(qmckl_context), intent(in), value :: context 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(:,:) double precision, allocatable :: A(:,:), B(:,:), C(:,:)
integer*8 :: m, n, LDA, LDB, LDC 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 = & test_qmckl_dist = &
qmckl_distance(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC) 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 if (test_qmckl_dist == 0) return
#endif
test_qmckl_dist = & test_qmckl_dist = &
qmckl_distance(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC) 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 if (test_qmckl_dist == 0) return
#endif
test_qmckl_dist = & test_qmckl_dist = &
qmckl_distance(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_dist /= 0) return 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 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 + & x = dsqrt((A(i,1)-B(j,1))**2 + &
(A(i,2)-B(j,2))**2 + & (A(i,2)-B(j,2))**2 + &
(A(i,3)-B(j,3))**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
end do end do
test_qmckl_dist = & test_qmckl_dist = &
qmckl_distance(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_dist /= 0) return 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 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 + & x = dsqrt((A(1,i)-B(j,1))**2 + &
(A(2,i)-B(j,2))**2 + & (A(2,i)-B(j,2))**2 + &
(A(3,i)-B(j,3))**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
end do end do
test_qmckl_dist = & test_qmckl_dist = &
qmckl_distance(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_dist /= 0) return 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 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 + & x = dsqrt((A(i,1)-B(1,j))**2 + &
(A(i,2)-B(2,j))**2 + & (A(i,2)-B(2,j))**2 + &
(A(i,3)-B(3,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
end do end do
test_qmckl_dist = & test_qmckl_dist = &
qmckl_distance(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC) qmckl_distance(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC)
#ifdef VFC_CI
if (test_qmckl_dist /= 0) return 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 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 + & x = dsqrt((A(1,i)-B(1,j))**2 + &
(A(2,i)-B(2,j))**2 + & (A(2,i)-B(2,j))**2 + &
(A(3,i)-B(3,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
end do end do
@ -800,8 +910,13 @@ end function test_qmckl_dist
#+end_src #+end_src
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test)
qmckl_exit_code test_qmckl_dist(qmckl_context context); #ifdef VFC_CI
assert(test_qmckl_dist(context) == QMCKL_SUCCESS); 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 #+end_src
* Rescaled Distance * Rescaled Distance
@ -1463,6 +1578,11 @@ end function qmckl_distance_rescaled_deriv_e_f
#+begin_src c :comments link :tangle (eval c_test) #+begin_src c :comments link :tangle (eval c_test)
assert (qmckl_context_destroy(context) == QMCKL_SUCCESS); assert (qmckl_context_destroy(context) == QMCKL_SUCCESS);
#ifdef VFC_CI
vfc_dump_probes(&probes);
#endif
return 0; return 0;
} }

View File

@ -608,6 +608,30 @@ qmckl_set_electron_rescale_factor_en(qmckl_context context,
return QMCKL_SUCCESS; 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 #+end_src
The following function sets the electron coordinates of all the 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 #+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 ** Test
#+begin_src python :results output :exports none #+begin_src python :results output :exports none

File diff suppressed because it is too large Load Diff