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:
parent
e329d0a125
commit
d0eb207404
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -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
|
||||||
|
|
|
@ -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@
|
||||||
|
|
26
configure.ac
26
configure.ac
|
@ -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}
|
||||||
--------------------------------------------------"
|
--------------------------------------------------"
|
||||||
|
|
||||||
|
|
|
@ -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
160
include/config.h.in~
Normal 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
|
126
org/qmckl_ao.org
126
org/qmckl_ao.org
|
@ -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
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
1882
share/doc/qmckl/html/htmlize.el
Normal file
1882
share/doc/qmckl/html/htmlize.el
Normal file
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user