From 4236b33a4f6077688f0a62cf8b159bf33e30c4be Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 13:58:05 +0200 Subject: [PATCH 01/61] Worked on Makefiles --- src/.gitignore | 3 ++ src/Makefile | 28 +++++-------- src/README.org | 14 ++++--- src/create_makefile.sh | 69 +++++++++++++++++++++++++++++++ src/org_to_code.sh | 38 +++++++++++++++++ src/qmckl.org | 47 +++++++++++++++++++++ src/qmckl_context.org | 94 +++++++++++++++++++++++++++++++++--------- 7 files changed, 251 insertions(+), 42 deletions(-) create mode 100755 src/create_makefile.sh create mode 100755 src/org_to_code.sh create mode 100644 src/qmckl.org diff --git a/src/.gitignore b/src/.gitignore index 37a9bfd..c36740c 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -1,3 +1,6 @@ *.o *.c *.h +*~ +*.so +Makefile.generated diff --git a/src/Makefile b/src/Makefile index 9255ca0..72d1cf5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,30 +1,24 @@ CC=gcc -CFLAGS=-fexceptions -Wall -Werror -Wpedantic -Wextra +CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra FC=gfortran FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan -ORG_SOURCE_FILES=qmckl_context.org -OBJECT_FILES=$(patsubst %.org,%.o,$(ORG_SOURCE_FILES)) +export CC CFLAGS FC FFLAGS -.PHONY: clean +ORG_SOURCE_FILES=$(wildcard qmckl*.org) +OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) -all: $(OBJECT_FILES) +.PHONY: clean +.SECONDARY: # Needed to keep the produced C and Fortran files -%.c %.h: %.org - emacs --quick --no-init-file --batch --eval "(require 'org)" --eval '(org-babel-tangle-file "$^")' - -%.c %.h %_f.f90: %.org - emacs --quick --no-init-file --batch --eval "(require 'org)" --eval '(org-babel-tangle-file "$^")' - -%.o: %.c - $(CC) $(CFLAGS) -c $*.c -o $*.o - -%.o: %.f90 - $(FC) $(FFLAGS) -c $*.f90 -o $*.o +libqmckl.so: Makefile.generated + $(MAKE) -f Makefile.generated clean: - rm -f qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h + rm -f qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so +Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh + ./create_makefile.sh $(ORG_SOURCE_FILES) diff --git a/src/README.org b/src/README.org index 2588e5e..c5744fc 100644 --- a/src/README.org +++ b/src/README.org @@ -8,27 +8,31 @@ comments and LaTex formulas close to the code. There exists multiple possibilities to convert org-mode files into different formats such as HTML or pdf. - For a tutorial on literate programming with org-mode, follow + For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. The code is extracted from the org files using Emacs as a command-line tool in the =Makefile=, and then the produced files are compiled. + If the name of the file is =xxx.org=, the name of the produced C + files should be =xxx.c= and =xxx.h= and the name of the produced + Fortran files should be =xxx.f90= + *** Source code editing Any text editor can be used to edit org-mode files. For a better user experience Emacs is recommended. For users hating Emacs, it is good to know that Emacs can behave like Vim when switched into ``Evil'' mode. There also exists - [[https://www.spacemacs.org][Spacemacs]] which is particularly well adapted to Vim users. + [[https://www.spacemacs.org][Spacemacs]] which helps the transition for Vim users. For users with a preference for Jupyter notebooks, the following script can convert jupyter notebooks to org-mode files: #+BEGIN_SRC sh tangle: nb_to_org.sh #!/bin/bash -# $ nb_to_org.sh notebook.ipynb -# produces the org-mode file notebook.org +# $ nb_to_org.sh notebook.ipynb +# produces the org-mode file notebook.org set -e @@ -45,7 +49,7 @@ rm ${nb}.md The Fortran source files should provide a C interface using iso-c-binding. The name of the Fortran source files should end with =_f.f90= to be properly handled by the Makefile. - + ** Documentation - [[qmckl_context.org][Context]] diff --git a/src/create_makefile.sh b/src/create_makefile.sh new file mode 100755 index 0000000..66b40dc --- /dev/null +++ b/src/create_makefile.sh @@ -0,0 +1,69 @@ +#!/bin/bash + +OUTPUT=Makefile.generated + +# Tangle org files + +emacsclient -a "" \ + --socket-name=org_to_code \ + --eval "(require 'org)" + +for INPUT in $@ ; do + emacsclient \ + --no-wait \ + --socket-name=org_to_code \ + --eval "(org-babel-tangle-file \"$INPUT\")" +done + +emacsclient \ + --no-wait \ + --socket-name=org_to_code \ + --eval '(kill-emacs)' + + + +# Create the list of *.o files to be created + +OBJECTS="" +for i in $(ls qmckl_*.c) ; do + FILE=${i%.c} + OBJECTS="${OBJECTS} ${FILE}.o" +done >> $OUTPUT + +for i in $(ls qmckl_*.f90) ; do + FILE=${i%.f90} + OBJECTS="${OBJECTS} ${FILE}.o" +done >> $OUTPUT + + +# Write the Makefile + +cat << EOF > $OUTPUT +CC=$CC +CFLAGS=$CFLAGS + +FC=$FC +FFLAGS=$FFLAGS +OBJECT_FILES=$OBJECTS + +libqmckl.so: \$(OBJECT_FILES) + \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so + +%.o: %.c + \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o + +%.o: %.f90 + \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o + +EOF + +for i in $(ls qmckl_*.c) ; do + FILE=${i%.c} + echo "${FILE}.o: ${FILE}.c " *.h +done >> $OUTPUT + +for i in $(ls qmckl_*.f90) ; do + FILE=${i%.f90} + echo "${FILE}.o: ${FILE}.f90" +done >> $OUTPUT + diff --git a/src/org_to_code.sh b/src/org_to_code.sh new file mode 100755 index 0000000..4afe7d8 --- /dev/null +++ b/src/org_to_code.sh @@ -0,0 +1,38 @@ +#!/usr/bin/env bash + +if [[ -z $1 ]] ; then + echo "Usage: $0 " + exit 1; +fi + +if [[ -z $6 ]] ; then +# Few file to tangle + + for INPUT in $@ ; do + emacs \ + --quick \ + --no-init-file \ + --batch \ + --eval "(require 'org)" \ + --eval "(org-babel-tangle-file \"$INPUT\")" + done + +else +# Multiple files to tangle, so we use the emacs server to speed up thing + + emacsclient -a "" \ + --socket-name=org_to_code \ + --eval "(require 'org)" + + for INPUT in $@ ; do + emacsclient \ + --no-wait \ + --socket-name=org_to_code \ + --eval "(org-babel-tangle-file \"$INPUT\")" + done + + emacsclient \ + --no-wait \ + --socket-name=org_to_code \ + --eval '(kill-emacs)' +fi diff --git a/src/qmckl.org b/src/qmckl.org new file mode 100644 index 0000000..dd271fb --- /dev/null +++ b/src/qmckl.org @@ -0,0 +1,47 @@ +# -*- mode: org -*- +# vim: syntax=c +#+TITLE: QMCkl C header + +This file is included in all other C header files, and produces the +=qmckl.h= header file. + +#+BEGIN_SRC C :tangle qmckl.h +#ifndef QMCKL_H +#define QMCKL_H +#+END_SRC + +* Constants + +** Success/failure + + These are the codes returned by the functions to indicate success + or failure. All such functions should have as a return type =qmckl_exit_code=. + + #+BEGIN_SRC C :tangle qmckl.h +#define QMCKL_SUCCESS 0 +#define QMCKL_FAILURE 1 + +typedef int qmckl_exit_code; + #+END_SRC + + +** Precision-related constants + + #+BEGIN_SRC C :tangle qmckl.h +#define QMCKL_DEFAULT_PRECISION 53 +#define QMCKL_DEFAULT_RANGE 2 + #+END_SRC + +* Header files + + #+BEGIN_SRC C :tangle qmckl.h +#include "qmckl_context.h" + #+END_SRC + +* End of header + +#+BEGIN_SRC C :tangle qmckl.h +#endif +#+END_SRC + + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 255b2dc..d8c5ddf 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,10 +1,15 @@ # -*- mode: org -*- - +# vim: syntax=c #+TITLE: Context This file is written in C because it is more natural to express the context in C than in Fortran. +#+BEGIN_SRC C :tangle qmckl_context.h +#ifndef QMCKL_CONTEXT_H +#define QMCKL_CONTEXT_H +#include "qmckl.h" +#+END_SRC #+BEGIN_SRC C :tangle qmckl_context.c #include /* malloc */ @@ -17,19 +22,15 @@ C than in Fortran. is stored in the following data structure, which can't be seen outside of the library. - #+BEGIN_SRC C :tangle qmckl_context.h -#define QMCKL_DEFAULT_PRECISION 53 -#define QMCKL_DEFAULT_RANGE 2 - /* 64-bit integer */ typedef long long int qmckl_context ; #+END_SRC #+BEGIN_SRC C :tangle qmckl_context.c -typedef struct qmckl_context_struct_ { - struct qmckl_context_struct_ * prev; +typedef struct qmckl_context_struct { + struct qmckl_context_struct * prev; int precision; int range; } qmckl_context_struct; @@ -121,8 +122,53 @@ int qmckl_context_destroy(qmckl_context context) { The following functions set and get the expected required precision and range. =precision= should be an integer between 2 and 53, and =range= should be an integer between 2 and 11. + The setter functions functions return a new context as a 64-bit integer. The getter functions return the value, as a 32-bit integer. + The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. + +** =qmckl_context_update_precision= + + #+BEGIN_SRC C :tangle qmckl_context.h +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision); + #+END_SRC + + #+BEGIN_SRC C :tangle qmckl_context.c +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision) { + qmckl_context_struct* ctx; + + if (precision < 2) return QMCKL_FAILURE; + if (precision > 53) return QMCKL_FAILURE; + + ctx = (qmckl_context_struct*) context; + if (ctx == NULL) return QMCKL_FAILURE; + + ctx->precision = precision; + return QMCKL_SUCCESS; +} + #+END_SRC + +** =qmckl_context_update_range= + #+BEGIN_SRC C :tangle qmckl_context.h +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range); + #+END_SRC + + #+BEGIN_SRC C :tangle qmckl_context.c +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range) { + qmckl_context_struct* ctx; + + if (range < 2) return QMCKL_FAILURE; + if (range > 11) return QMCKL_FAILURE; + + ctx = (qmckl_context_struct*) context; + if (ctx == NULL) return QMCKL_FAILURE; + + ctx->range = range; + return QMCKL_SUCCESS; +} + #+END_SRC + + ** =qmckl_context_set_precision= @@ -131,15 +177,15 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, int preci #+END_SRC #+BEGIN_SRC C :tangle qmckl_context.c -qmckl_context qmckl_context_set_precision(const qmckl_context context, int precision) { - qmckl_context_struct* ctx; +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { + qmckl_context new_context; - if (precision < 2) return (qmckl_context) 0; - if (precision > 53) return (qmckl_context) 0; + new_context = qmckl_context_copy(context); + if (new_context == 0) return 0; - ctx = (qmckl_context_struct*) qmckl_context_copy(context); - ctx->precision = precision; - return (qmckl_context) ctx; + if (qmckl_context_update_precision(context, precision) == QMCKL_FAILURE) return 0; + + return new_context; } #+END_SRC @@ -150,14 +196,14 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, int range); #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_set_range(const qmckl_context context, int range) { - qmckl_context_struct* ctx; + qmckl_context new_context; - if (range < 2) return (qmckl_context) 0; - if (range > 11) return (qmckl_context) 0; + new_context = qmckl_context_copy(context); + if (new_context == 0) return 0; - ctx = (qmckl_context_struct*) qmckl_context_copy(context); - ctx->range = range; - return (qmckl_context) ctx; + if (qmckl_context_update_range(context, range) == QMCKL_FAILURE) return 0; + + return new_context; } #+END_SRC @@ -191,3 +237,11 @@ int qmckl_context_get_range(const qmckl_context context) { } #+END_SRC + + +* End of header + +#+BEGIN_SRC C :tangle qmckl_context.h +#endif +#+END_SRC + From 3a3ea1b8fee7f6e329ed261376ff53607f234f7d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 18:23:20 +0200 Subject: [PATCH 02/61] Moved Wiki documentation into the project --- README.md | 20 ++++++-- src/README.org | 135 ++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 146 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index 7d64383..438414c 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,21 @@ -# qmckl +# Quantum Monte Carlo Kernel Library. ![Build Status](https://github.com/TREX-CoE/qmckl/workflows/test-build/badge.svg?branch=main) -Quantum Monte Carlo Kernel Library. +The domain of quantum chemistry needs a library in which the main +kernels of Quantum Monte Carlo (QMC) methods are implemented. In the +library proposed in this project, we expose the main algorithms in a +language and provide a standard API and tests to enable the +development of high-performance QMCkl implementations taking +advantage of modern hardware. -See the [Wiki](https://github.com/TREX-CoE/qmckl/wiki) for more information. +See the [source code](https://github.com/TREX-CoE/qmckl/src/README.org) +to read the documentation. + + + +------------------------------ + +[[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] +[TREX: Targeting Real Chemical Accuracy at the Exascale](https://trex-coe.eu) project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. + \ No newline at end of file diff --git a/src/README.org b/src/README.org index c5744fc..75b0a3e 100644 --- a/src/README.org +++ b/src/README.org @@ -2,9 +2,15 @@ ** Introduction - The main objective of present library is documentation. Therefore, - literate programming is particularly adapted in this context. - Source files are written in org-mode format, to provide useful + The ultimate goal of QMCkl is to provide a high-performance + implementation of the main kernels of QMC. In this particular + repository, we focus on the definition of the API and the tests, + and on a /pedagogical/ presentation of the algorithms. We expect the + HPC experts to use this repository as a reference for re-writing + optimized libraries. + + Literate programming is particularly adapted in this context. + Source files are written in [[ottps://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, to provide useful comments and LaTex formulas close to the code. There exists multiple possibilities to convert org-mode files into different formats such as HTML or pdf. @@ -14,9 +20,21 @@ The code is extracted from the org files using Emacs as a command-line tool in the =Makefile=, and then the produced files are compiled. - If the name of the file is =xxx.org=, the name of the produced C - files should be =xxx.c= and =xxx.h= and the name of the produced - Fortran files should be =xxx.f90= +*** Language used + + Fortran is one of the most common languages used by the community, + and is simple enough to make the algorithms readable. Hence we + propose in this pedagogical implementation of QMCkl to use Fortran + to express the algorithms. For specific internal functions where + the C language is more natural, C is used. + + As Fortran modules generate compiler-dependent files, the use of + modules is restricted to the internal use of the library, otherwise + the compliance with C is violated. + + The external dependencies should be kept as small as possible, so + external libraries should be used /only/ if their used is strongly + justified. *** Source code editing @@ -50,8 +68,113 @@ rm ${nb}.md iso-c-binding. The name of the Fortran source files should end with =_f.f90= to be properly handled by the Makefile. +** Design of the library + + The proposed API should allow the library to: + - deal with memory transfers between CPU and accelerators + - use different levels of floating-point precision + + We chose a multi-layered design with low-level and high-level + functions (see below). + +*** Naming conventions + + Use =qmckl_= as a prefix for all exported functions and variables. + All exported header files should have a filename with the prefix + =qmckl_=. + + If the name of the org-mode file is =xxx.org=, the name of the + produced C files should be =xxx.c= and =xxx.h= and the name of the + produced Fortran files should be =xxx.f90= + +*** Application programming interface + + The application programming interface (API) is designed to be + compatible with the C programming language (not C++), to ensure + that the library will be easily usable in any language. + This implies that only the following data types are allowed in the API: + + - 32-bit and 64-bit floats and arrays + - 32-bit and 64-bit integers and arrays + - Pointers should be represented as 64-bit integers (even on + 32-bit architectures) + - ASCII strings are represented as a pointers to a character arrays + and terminated by a zero character (C convention). + + To facilitate the use in other languages than C, we provide some + bindings in other languages in other repositories. + + # TODO : Link to repositories for bindings + +*** Global state + + Global variables should be avoided in the library, because it is + possible that one single program needs to use multiple instances of + the library. To solve this problem we propose to use a pointer to a + =context= variable, built by the library with the + =qmckl_context_create= function. The =context= contains the global + state of the library, and is used as the first argument of many + QMCkl functions. + + Modifying the state is done by setters and getters, prefixed + by =qmckl_context_set_= an =qmckl_context_get_=. + When a context variable is modified by a setter, a copy of the old + data structure is made and updated, and the pointer to the new data + structure is returned, such that the old contexts can still be + accessed. + It is also possible to modify the state in an impure fashion, using + the =qmckl_context_update_= functions. + The context and its old versions can be destroyed with + =qmckl_context_destroy=. + +*** Low-level functions + + Low-level functions are very simple functions which are leaves of the + function call tree (they don't call any other QMCkl function). + + This functions are /pure/, and unaware of the QMCkl =context=. They are + not allowed to allocate/deallocate memory, and if they need + temporary memory it should be provided in input. + +*** High-level functions + + High-level functions are at the top of the function call tree. + They are able to choose which lower-level function to call + depending on the required precision, and do the corresponding type + conversions. + These functions are also responsible for allocating temporary + storage, to simplify the use of accelerators. + + The high-level functions should be pure, unless the introduction of + non-purity is justified. All the side effects should be made in the + =context= variable. + + # TODO : We need an identifier for impure functions + +*** Numerical precision + + The number of bits of precision required for a function should be + given as an input of low-level computational functions. This input will + be used to define the values of the different thresholds that might + be used to avoid computing unnecessary noise. + High-level functions will use the precision specified in the + =context= variable. + +** Algorithms + + Reducing the scaling of an algorithm usually implies also reducing + its arithmetic complexity (number of flops per byte). Therefore, + for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms + are better adapted than linear scaling algorithms. + As QMCkl is a general purpose library, multiple algorithms should + be implemented adapted to different problem sizes. + ** Documentation +- [[qmckl.org][Main QMCkl header file]] - [[qmckl_context.org][Context]] +** Acknowledgments +[[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] +[[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. From 55676a900258afc68f66bbbc5dcc34c8994d1f19 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 18:23:20 +0200 Subject: [PATCH 03/61] Moved Wiki documentation into the project --- README.md | 20 ++++++- src/README.org | 145 +++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 156 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index 7d64383..438414c 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,21 @@ -# qmckl +# Quantum Monte Carlo Kernel Library. ![Build Status](https://github.com/TREX-CoE/qmckl/workflows/test-build/badge.svg?branch=main) -Quantum Monte Carlo Kernel Library. +The domain of quantum chemistry needs a library in which the main +kernels of Quantum Monte Carlo (QMC) methods are implemented. In the +library proposed in this project, we expose the main algorithms in a +language and provide a standard API and tests to enable the +development of high-performance QMCkl implementations taking +advantage of modern hardware. -See the [Wiki](https://github.com/TREX-CoE/qmckl/wiki) for more information. +See the [source code](https://github.com/TREX-CoE/qmckl/src/README.org) +to read the documentation. + + + +------------------------------ + +[[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] +[TREX: Targeting Real Chemical Accuracy at the Exascale](https://trex-coe.eu) project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. + \ No newline at end of file diff --git a/src/README.org b/src/README.org index c5744fc..fac2ecf 100644 --- a/src/README.org +++ b/src/README.org @@ -2,9 +2,15 @@ ** Introduction - The main objective of present library is documentation. Therefore, - literate programming is particularly adapted in this context. - Source files are written in org-mode format, to provide useful + The ultimate goal of QMCkl is to provide a high-performance + implementation of the main kernels of QMC. In this particular + repository, we focus on the definition of the API and the tests, + and on a /pedagogical/ presentation of the algorithms. We expect the + HPC experts to use this repository as a reference for re-writing + optimized libraries. + + Literate programming is particularly adapted in this context. + Source files are written in [[ottps://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, to provide useful comments and LaTex formulas close to the code. There exists multiple possibilities to convert org-mode files into different formats such as HTML or pdf. @@ -14,9 +20,21 @@ The code is extracted from the org files using Emacs as a command-line tool in the =Makefile=, and then the produced files are compiled. - If the name of the file is =xxx.org=, the name of the produced C - files should be =xxx.c= and =xxx.h= and the name of the produced - Fortran files should be =xxx.f90= +*** Language used + + Fortran is one of the most common languages used by the community, + and is simple enough to make the algorithms readable. Hence we + propose in this pedagogical implementation of QMCkl to use Fortran + to express the algorithms. For specific internal functions where + the C language is more natural, C is used. + + As Fortran modules generate compiler-dependent files, the use of + modules is restricted to the internal use of the library, otherwise + the compliance with C is violated. + + The external dependencies should be kept as small as possible, so + external libraries should be used /only/ if their used is strongly + justified. *** Source code editing @@ -50,8 +68,123 @@ rm ${nb}.md iso-c-binding. The name of the Fortran source files should end with =_f.f90= to be properly handled by the Makefile. +*** Coding style + # TODO: decide on a coding style + + To improve readability, we maintain a consistent coding style in the library. + + - For C source files, we will use __(decide on a coding style)__ + - For Fortran source files, we will use __(decide on a coding style)__ + + Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. + +** Design of the library + + The proposed API should allow the library to: + - deal with memory transfers between CPU and accelerators + - use different levels of floating-point precision + + We chose a multi-layered design with low-level and high-level + functions (see below). + +*** Naming conventions + + Use =qmckl_= as a prefix for all exported functions and variables. + All exported header files should have a filename with the prefix + =qmckl_=. + + If the name of the org-mode file is =xxx.org=, the name of the + produced C files should be =xxx.c= and =xxx.h= and the name of the + produced Fortran files should be =xxx.f90= + +*** Application programming interface + + The application programming interface (API) is designed to be + compatible with the C programming language (not C++), to ensure + that the library will be easily usable in any language. + This implies that only the following data types are allowed in the API: + + - 32-bit and 64-bit floats and arrays + - 32-bit and 64-bit integers and arrays + - Pointers should be represented as 64-bit integers (even on + 32-bit architectures) + - ASCII strings are represented as a pointers to a character arrays + and terminated by a zero character (C convention). + + To facilitate the use in other languages than C, we provide some + bindings in other languages in other repositories. + + # TODO : Link to repositories for bindings + +*** Global state + + Global variables should be avoided in the library, because it is + possible that one single program needs to use multiple instances of + the library. To solve this problem we propose to use a pointer to a + =context= variable, built by the library with the + =qmckl_context_create= function. The =context= contains the global + state of the library, and is used as the first argument of many + QMCkl functions. + + Modifying the state is done by setters and getters, prefixed + by =qmckl_context_set_= an =qmckl_context_get_=. + When a context variable is modified by a setter, a copy of the old + data structure is made and updated, and the pointer to the new data + structure is returned, such that the old contexts can still be + accessed. + It is also possible to modify the state in an impure fashion, using + the =qmckl_context_update_= functions. + The context and its old versions can be destroyed with + =qmckl_context_destroy=. + +*** Low-level functions + + Low-level functions are very simple functions which are leaves of the + function call tree (they don't call any other QMCkl function). + + This functions are /pure/, and unaware of the QMCkl =context=. They are + not allowed to allocate/deallocate memory, and if they need + temporary memory it should be provided in input. + +*** High-level functions + + High-level functions are at the top of the function call tree. + They are able to choose which lower-level function to call + depending on the required precision, and do the corresponding type + conversions. + These functions are also responsible for allocating temporary + storage, to simplify the use of accelerators. + + The high-level functions should be pure, unless the introduction of + non-purity is justified. All the side effects should be made in the + =context= variable. + + # TODO : We need an identifier for impure functions + +*** Numerical precision + + The number of bits of precision required for a function should be + given as an input of low-level computational functions. This input will + be used to define the values of the different thresholds that might + be used to avoid computing unnecessary noise. + High-level functions will use the precision specified in the + =context= variable. + +** Algorithms + + Reducing the scaling of an algorithm usually implies also reducing + its arithmetic complexity (number of flops per byte). Therefore, + for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms + are better adapted than linear scaling algorithms. + As QMCkl is a general purpose library, multiple algorithms should + be implemented adapted to different problem sizes. + ** Documentation +- [[qmckl.org][Main QMCkl header file]] - [[qmckl_context.org][Context]] +** Acknowledgments +[[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] +[[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. From db931247fb9854d5a9f224d071e59ea87c7108ca Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 18:30:36 +0200 Subject: [PATCH 04/61] Update README.md --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 438414c..602ecbb 100644 --- a/README.md +++ b/README.md @@ -16,6 +16,6 @@ to read the documentation. ------------------------------ -[[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] +![European flag](https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg) [TREX: Targeting Real Chemical Accuracy at the Exascale](https://trex-coe.eu) project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. - \ No newline at end of file + From 795803ef847c1f91c6250a0e6260246138f28a3b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 18:31:07 +0200 Subject: [PATCH 05/61] Update README.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 602ecbb..545bd61 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ The domain of quantum chemistry needs a library in which the main kernels of Quantum Monte Carlo (QMC) methods are implemented. In the library proposed in this project, we expose the main algorithms in a -language and provide a standard API and tests to enable the +simple language and provide a standard API and tests to enable the development of high-performance QMCkl implementations taking advantage of modern hardware. From 9e5b2b4fa5ff42b3f3425a1d2ba9f6ac6fc5b33d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 18:32:25 +0200 Subject: [PATCH 06/61] Update README.md --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 545bd61..71f31d0 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# Quantum Monte Carlo Kernel Library. +# QMCkl: Quantum Monte Carlo Kernel Library ![Build Status](https://github.com/TREX-CoE/qmckl/workflows/test-build/badge.svg?branch=main) @@ -9,7 +9,7 @@ simple language and provide a standard API and tests to enable the development of high-performance QMCkl implementations taking advantage of modern hardware. -See the [source code](https://github.com/TREX-CoE/qmckl/src/README.org) +See the [source code](https://github.com/TREX-CoE/qmckl/tree/main/src) to read the documentation. From 534e11cccb7fe32105e1abb51cd5101bb1f4e892 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 19:42:12 +0200 Subject: [PATCH 07/61] Added tests --- src/qmckl.org | 13 ++- src/qmckl_context.org | 210 ++++++++++++++++++++++++++++++++++++------ 2 files changed, 192 insertions(+), 31 deletions(-) diff --git a/src/qmckl.org b/src/qmckl.org index dd271fb..0a400d5 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -2,8 +2,8 @@ # vim: syntax=c #+TITLE: QMCkl C header -This file is included in all other C header files, and produces the -=qmckl.h= header file. +This file produces the =qmckl.h= header file, which is included in all +other C header files. It is the main entry point to the library. #+BEGIN_SRC C :tangle qmckl.h #ifndef QMCKL_H @@ -27,13 +27,20 @@ typedef int qmckl_exit_code; ** Precision-related constants + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. + #+BEGIN_SRC C :tangle qmckl.h #define QMCKL_DEFAULT_PRECISION 53 -#define QMCKL_DEFAULT_RANGE 2 +#define QMCKL_DEFAULT_RANGE 11 #+END_SRC * Header files + All the functions expoed in the API are defined in the following + header files. + #+BEGIN_SRC C :tangle qmckl.h #include "qmckl_context.h" #+END_SRC diff --git a/src/qmckl_context.org b/src/qmckl_context.org index d8c5ddf..5a80a1c 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -5,48 +5,77 @@ This file is written in C because it is more natural to express the context in C than in Fortran. -#+BEGIN_SRC C :tangle qmckl_context.h +3 files are produced: +- a header file : =qmckl_context.h= +- a source file : =qmckl_context.c= +- a test file : =test_qmckl_context.c= + +*** Header + #+BEGIN_SRC C :tangle qmckl_context.h #ifndef QMCKL_CONTEXT_H #define QMCKL_CONTEXT_H #include "qmckl.h" -#+END_SRC + #+END_SRC -#+BEGIN_SRC C :tangle qmckl_context.c +*** Source + #+BEGIN_SRC C :tangle qmckl_context.c #include /* malloc */ #include "qmckl_context.h" -#+END_SRC + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_context.c +#include "qmckl_context.h" +#include "qmckl_test.h" +int main() { + qmckl_exit_code rc; /* return code */ + rc = QMCKL_SUCCESS; + #+END_SRC * Context The context variable is a handle for the state of the library, and is stored in the following data structure, which can't be seen - outside of the library. + outside of the library. To simplify compatibility with other + languages, the pointer to the internal data structure is converted + into a 64-bit signed integer, defined in the =qmckl_context= type. + A value of 0 for the context is equivalent to a NULL pointer. - #+BEGIN_SRC C :tangle qmckl_context.h +*** Header + #+BEGIN_SRC C :tangle qmckl_context.h /* 64-bit integer */ typedef long long int qmckl_context ; - #+END_SRC + #+END_SRC - - #+BEGIN_SRC C :tangle qmckl_context.c +*** Source + #+BEGIN_SRC C :tangle qmckl_context.c typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; int precision; int range; } qmckl_context_struct; - #+END_SRC + #+END_SRC + +*** Test + We declare here the variables used in the tests. + #+BEGIN_SRC C :tangle test_qmckl_context.c + qmckl_context context; + qmckl_context new_context; + #+END_SRC ** =qmckl_context_create= - To create a new context, use =qmckl_context_create()=. If the creation - failed, the function returns =0=. On success, a pointer to a context - is returned as a 64-bit integer. + To create a new context, use =qmckl_context_create()=. + - On success, returns a pointer to a context using the =qmckl_context= type + - Returns 0 upon failure to allocate the internal data structure - #+BEGIN_SRC C :tangle qmckl_context.h +*** Header + #+BEGIN_SRC C :tangle qmckl_context.h qmckl_context qmckl_context_create(); - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :tangle qmckl_context.c +*** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_create() { qmckl_context_struct* context; @@ -62,20 +91,46 @@ qmckl_context qmckl_context_create() { return (qmckl_context) context; } - #+END_SRC + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_context.c + context = qmckl_context_create(); + if (context == (qmckl_context) 0) { + eprintf("qmckl_context_create\n"); + rc = QMCKL_FAILURE; + } + if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) { + eprintf("qmckl_context_copy: No access to data\n"); + rc = QMCKL_FAILURE; + } + #+END_SRC ** =qmckl_context_copy= + + This function makes a shallow copy of the current context. + - Copying the 0-valued context returns 0 + - On success, returns a pointer to the new context using the =qmckl_context= type + - Returns 0 upon failure to allocate the internal data structure + for the new context + +*** Header #+BEGIN_SRC C :tangle qmckl_context.h qmckl_context qmckl_context_copy(const qmckl_context context); #+END_SRC +*** Source #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_copy(const qmckl_context context) { qmckl_context_struct* old_context; qmckl_context_struct* new_context; + if (context == (qmckl_context) 0) { + return (qmckl_context) 0; + } + new_context = (qmckl_context_struct*) malloc (sizeof(qmckl_context_struct)); if (new_context == NULL) { return (qmckl_context) 0; @@ -91,32 +146,124 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { } #+END_SRC -** =qmckl_context_destroy= +*** Test + #+BEGIN_SRC C :tangle test_qmckl_context.c + new_context = qmckl_context_copy(context); + if (new_context == (qmckl_context) 0) { + eprintf("qmckl_context_copy: Allocation failure\n"); + rc = QMCKL_FAILURE; + } + if (new_context == context ) { + eprintf("qmckl_context_copy: Same pointer\n"); + rc = QMCKL_FAILURE; + } + if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) { + eprintf("qmckl_context_copy: No access to data\n"); + rc = QMCKL_FAILURE; + } + #+END_SRC - To delete a new context, use =qmckl_context_destroy()=. If the deletion - failed, the function returns =0=. On success, the function returns =1= - implying that the context has been freed. +** =qmckl_context_previous= + + Returns the previous context + - On success, returns the ancestor of the current context + - Returns 0 for the initial context + - Returns 0 for the 0-valued context +*** Header #+BEGIN_SRC C :tangle qmckl_context.h -int qmckl_context_destroy(qmckl_context context); +qmckl_context qmckl_context_previous(const qmckl_context context); #+END_SRC +*** Source #+BEGIN_SRC C :tangle qmckl_context.c -int qmckl_context_destroy(qmckl_context context) { +qmckl_context qmckl_context_previous(const qmckl_context context) { qmckl_context_struct* ctx; + if (context == (qmckl_context) 0) { + return (qmckl_context) 0; + } + ctx = (qmckl_context_struct*) context; + return (qmckl_context) ctx->prev; +} + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_context.c + if (qmckl_context_previous(new_context) == (qmckl_context) 0) { + eprintf("qmckl_context_copy: Null pointer\n"); + rc = QMCKL_FAILURE; + } + if (qmckl_context_previous(new_context) != context) { + eprintf("qmckl_context_copy: Wrong pointer\n"); + rc = QMCKL_FAILURE; + } + if (qmckl_context_previous(context) != (qmckl_context) 0) { + eprintf("qmckl_context_copy: Expected null pointer (1)\n"); + rc = QMCKL_FAILURE; + } + if (qmckl_context_previous((qmckl_context) 0) != (qmckl_context) 0) { + eprintf("qmckl_context_copy: Expected null pointer (2)\n"); + rc = QMCKL_FAILURE; + } + #+END_SRC + +** =qmckl_context_destroy= + + Destroys the current context, leaving the ancestors untouched. + - Succeeds if the current context is properly destroyed + - Fails otherwise + - Fails is the 0-valued context is given in argument + + The context given in parameter is overwritten by the 0-valued + context, so a pointer is passed to the function. + +*** Header + #+BEGIN_SRC C :tangle qmckl_context.h +qmckl_exit_code qmckl_context_destroy(qmckl_context * context); + #+END_SRC + +*** Source + #+BEGIN_SRC C :tangle qmckl_context.c +qmckl_exit_code qmckl_context_destroy(qmckl_context *context) { + + qmckl_context_struct* ctx; + + ctx = (qmckl_context_struct*) *context; if (ctx == NULL) { - return 0; + return QMCKL_FAILURE; } free(ctx); - return 1; + *context = (qmckl_context) 0; + return QMCKL_SUCCESS; } #+END_SRC +*** Test + #+BEGIN_SRC C :tangle test_qmckl_context.c + if (new_context == (qmckl_context) 0) { + eprintf("qmckl_context_destroy: new_context is NULL\n"); + rc = QMCKL_FAILURE; + } + if (qmckl_context_destroy(&new_context) == QMCKL_FAILURE) { + eprintf("qmckl_context_destroy: Unable to destroy the new_context\n"); + rc = QMCKL_FAILURE; + } + if (new_context != (qmckl_context) 0) { + eprintf("qmckl_context_destroy: new_context should be NULL\n"); + rc = QMCKL_FAILURE; + } + if (qmckl_context_destroy((qmckl_context) 0) == QMCKL_SUCCESS) { + eprintf("qmckl_context_destroy: Failure expected with NULL pointer\n"); + rc = QMCKL_FAILURE; + } + #+END_SRC + + * Precision The following functions set and get the expected required precision @@ -239,9 +386,16 @@ int qmckl_context_get_range(const qmckl_context context) { -* End of header +* End of files -#+BEGIN_SRC C :tangle qmckl_context.h +*** Header + #+BEGIN_SRC C :tangle qmckl_context.h #endif -#+END_SRC + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_context.c + return QMCKL_SUCCESS; +} + #+END_SRC From 87cfdc88d31f7f7b81913700eb9ff9b61f5267b1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 19:52:11 +0200 Subject: [PATCH 08/61] updated tests, but tests fail --- src/qmckl_context.org | 37 +++++++++++++++++++++++-------------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 5a80a1c..7797d39 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -26,7 +26,7 @@ C than in Fortran. *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c #include "qmckl_context.h" -#include "qmckl_test.h" +#include int main() { qmckl_exit_code rc; /* return code */ rc = QMCKL_SUCCESS; @@ -61,6 +61,15 @@ typedef struct qmckl_context_struct { #+BEGIN_SRC C :tangle test_qmckl_context.c qmckl_context context; qmckl_context new_context; + +/* This needs to be repeated in the tests because we don't want to + expose it in the headers. +*/ +typedef struct qmckl_context_struct { + struct qmckl_context_struct * prev; + int precision; + int range; +} qmckl_context_struct; #+END_SRC ** =qmckl_context_create= @@ -97,11 +106,11 @@ qmckl_context qmckl_context_create() { #+BEGIN_SRC C :tangle test_qmckl_context.c context = qmckl_context_create(); if (context == (qmckl_context) 0) { - eprintf("qmckl_context_create\n"); + fprintf(stderr,"qmckl_context_create\n"); rc = QMCKL_FAILURE; } if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) { - eprintf("qmckl_context_copy: No access to data\n"); + fprintf(stderr,"qmckl_context_copy: No access to data\n"); rc = QMCKL_FAILURE; } #+END_SRC @@ -150,15 +159,15 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { #+BEGIN_SRC C :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); if (new_context == (qmckl_context) 0) { - eprintf("qmckl_context_copy: Allocation failure\n"); + fprintf(stderr,"qmckl_context_copy: Allocation failure\n"); rc = QMCKL_FAILURE; } if (new_context == context ) { - eprintf("qmckl_context_copy: Same pointer\n"); + fprintf(stderr,"qmckl_context_copy: Same pointer\n"); rc = QMCKL_FAILURE; } if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) { - eprintf("qmckl_context_copy: No access to data\n"); + fprintf(stderr,"qmckl_context_copy: No access to data\n"); rc = QMCKL_FAILURE; } #+END_SRC @@ -193,19 +202,19 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c if (qmckl_context_previous(new_context) == (qmckl_context) 0) { - eprintf("qmckl_context_copy: Null pointer\n"); + fprintf(stderr,"qmckl_context_copy: Null pointer\n"); rc = QMCKL_FAILURE; } if (qmckl_context_previous(new_context) != context) { - eprintf("qmckl_context_copy: Wrong pointer\n"); + fprintf(stderr,"qmckl_context_copy: Wrong pointer\n"); rc = QMCKL_FAILURE; } if (qmckl_context_previous(context) != (qmckl_context) 0) { - eprintf("qmckl_context_copy: Expected null pointer (1)\n"); + fprintf(stderr,"qmckl_context_copy: Expected null pointer (1)\n"); rc = QMCKL_FAILURE; } if (qmckl_context_previous((qmckl_context) 0) != (qmckl_context) 0) { - eprintf("qmckl_context_copy: Expected null pointer (2)\n"); + fprintf(stderr,"qmckl_context_copy: Expected null pointer (2)\n"); rc = QMCKL_FAILURE; } #+END_SRC @@ -246,19 +255,19 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context *context) { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c if (new_context == (qmckl_context) 0) { - eprintf("qmckl_context_destroy: new_context is NULL\n"); + fprintf(stderr,"qmckl_context_destroy: new_context is NULL\n"); rc = QMCKL_FAILURE; } if (qmckl_context_destroy(&new_context) == QMCKL_FAILURE) { - eprintf("qmckl_context_destroy: Unable to destroy the new_context\n"); + fprintf(stderr,"qmckl_context_destroy: Unable to destroy the new_context\n"); rc = QMCKL_FAILURE; } if (new_context != (qmckl_context) 0) { - eprintf("qmckl_context_destroy: new_context should be NULL\n"); + fprintf(stderr,"qmckl_context_destroy: new_context should be NULL\n"); rc = QMCKL_FAILURE; } if (qmckl_context_destroy((qmckl_context) 0) == QMCKL_SUCCESS) { - eprintf("qmckl_context_destroy: Failure expected with NULL pointer\n"); + fprintf(stderr,"qmckl_context_destroy: Failure expected with NULL pointer\n"); rc = QMCKL_FAILURE; } #+END_SRC From ec7df80028b313e7fcec53a222ced3d56c76c193 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 23:38:35 +0200 Subject: [PATCH 09/61] Add tag to check if memory pointers are valid --- src/Makefile | 2 +- src/qmckl_context.org | 114 ++++++++++++++++++++++++++++-------------- 2 files changed, 77 insertions(+), 39 deletions(-) diff --git a/src/Makefile b/src/Makefile index 72d1cf5..fa56849 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,5 +1,5 @@ CC=gcc -CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra +CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g FC=gfortran FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 7797d39..f98b481 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -51,27 +51,50 @@ typedef long long int qmckl_context ; #+BEGIN_SRC C :tangle qmckl_context.c typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; + unsigned int tag; int precision; int range; } qmckl_context_struct; + +#define VALID_TAG 0xBEEFFACE +#define INVALID_TAG 0xDEADBEEF #+END_SRC - + + The tag is used internally to check if the memory domain pointed by + a pointer is a valid context. + *** Test We declare here the variables used in the tests. #+BEGIN_SRC C :tangle test_qmckl_context.c qmckl_context context; qmckl_context new_context; - -/* This needs to be repeated in the tests because we don't want to - expose it in the headers. -*/ -typedef struct qmckl_context_struct { - struct qmckl_context_struct * prev; - int precision; - int range; -} qmckl_context_struct; #+END_SRC + +** =qmckl_context_check= + + Checks if the domain pointed by the pointer is a valid context. + Returns the input =qmckl_context= if the context is valid, 0 otherwise. + +*** Header + #+BEGIN_SRC C :tangle qmckl_context.h +qmckl_context qmckl_context_check(qmckl_context context) ; + #+END_SRC + +*** Source + #+BEGIN_SRC C :tangle qmckl_context.c +qmckl_context qmckl_context_check(qmckl_context context) { + qmckl_context_struct * ctx; + + if (context == (qmckl_context) 0) return (qmckl_context) 0; + + ctx = (qmckl_context_struct*) context; + if (ctx->tag != VALID_TAG) return (qmckl_context) 0; + + return context; +} + #+END_SRC + ** =qmckl_context_create= To create a new context, use =qmckl_context_create()=. @@ -97,6 +120,7 @@ qmckl_context qmckl_context_create() { context->prev = NULL; context->precision = QMCKL_DEFAULT_PRECISION; context->range = QMCKL_DEFAULT_RANGE; + context->tag = VALID_TAG; return (qmckl_context) context; } @@ -109,15 +133,14 @@ qmckl_context qmckl_context_create() { fprintf(stderr,"qmckl_context_create\n"); rc = QMCKL_FAILURE; } - if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) { - fprintf(stderr,"qmckl_context_copy: No access to data\n"); + if ( qmckl_context_check(context) != context) { + fprintf(stderr,"qmckl_context_create: Invalid context\n"); rc = QMCKL_FAILURE; } #+END_SRC ** =qmckl_context_copy= - This function makes a shallow copy of the current context. - Copying the 0-valued context returns 0 - On success, returns a pointer to the new context using the =qmckl_context= type @@ -135,8 +158,11 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { qmckl_context_struct* old_context; qmckl_context_struct* new_context; + qmckl_context checked_context; - if (context == (qmckl_context) 0) { + checked_context = qmckl_context_check(context); + + if (checked_context == (qmckl_context) 0) { return (qmckl_context) 0; } @@ -145,14 +171,16 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { return (qmckl_context) 0; } - old_context = (qmckl_context_struct*) context; + old_context = (qmckl_context_struct*) checked_context; new_context->prev = old_context; new_context->precision = old_context->precision; new_context->range = old_context->range; + new_context->tag = VALID_TAG; return (qmckl_context) new_context; } + #+END_SRC *** Test @@ -166,10 +194,11 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { fprintf(stderr,"qmckl_context_copy: Same pointer\n"); rc = QMCKL_FAILURE; } - if ( ((qmckl_context_struct*) new_context)->precision != QMCKL_DEFAULT_PRECISION ) { + if ( qmckl_context_check(new_context) != new_context) { fprintf(stderr,"qmckl_context_copy: No access to data\n"); rc = QMCKL_FAILURE; } + #+END_SRC ** =qmckl_context_previous= @@ -188,33 +217,35 @@ qmckl_context qmckl_context_previous(const qmckl_context context); #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_previous(const qmckl_context context) { + qmckl_context checked_context; qmckl_context_struct* ctx; - if (context == (qmckl_context) 0) { + checked_context = qmckl_context_check(context); + if (checked_context == (qmckl_context) 0) { return (qmckl_context) 0; } - ctx = (qmckl_context_struct*) context; - return (qmckl_context) ctx->prev; + ctx = (qmckl_context_struct*) checked_context; + return qmckl_context_check((qmckl_context) ctx->prev); } #+END_SRC *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c if (qmckl_context_previous(new_context) == (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_copy: Null pointer\n"); + fprintf(stderr,"qmckl_context_previous: Null pointer\n"); rc = QMCKL_FAILURE; } if (qmckl_context_previous(new_context) != context) { - fprintf(stderr,"qmckl_context_copy: Wrong pointer\n"); + fprintf(stderr,"qmckl_context_previous: Wrong pointer\n"); rc = QMCKL_FAILURE; } if (qmckl_context_previous(context) != (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_copy: Expected null pointer (1)\n"); + fprintf(stderr,"qmckl_context_previous: Expected null pointer (1)\n"); rc = QMCKL_FAILURE; } if (qmckl_context_previous((qmckl_context) 0) != (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_copy: Expected null pointer (2)\n"); + fprintf(stderr,"qmckl_context_previous: Expected null pointer (2)\n"); rc = QMCKL_FAILURE; } #+END_SRC @@ -224,45 +255,52 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { Destroys the current context, leaving the ancestors untouched. - Succeeds if the current context is properly destroyed - Fails otherwise - - Fails is the 0-valued context is given in argument + - Fails if the 0-valued context is given in argument + - Fails if the the pointer is not a valid context - The context given in parameter is overwritten by the 0-valued - context, so a pointer is passed to the function. - *** Header #+BEGIN_SRC C :tangle qmckl_context.h -qmckl_exit_code qmckl_context_destroy(qmckl_context * context); +qmckl_exit_code qmckl_context_destroy(qmckl_context context); #+END_SRC *** Source #+BEGIN_SRC C :tangle qmckl_context.c -qmckl_exit_code qmckl_context_destroy(qmckl_context *context) { +qmckl_exit_code qmckl_context_destroy(qmckl_context context) { qmckl_context_struct* ctx; + qmckl_context checked_context; + + checked_context = qmckl_context_check(context); + if (checked_context == (qmckl_context) 0) return QMCKL_FAILURE; - ctx = (qmckl_context_struct*) *context; - - if (ctx == NULL) { - return QMCKL_FAILURE; - } + ctx = (qmckl_context_struct*) context; + if (ctx == NULL) return QMCKL_FAILURE; + ctx->tag = INVALID_TAG; free(ctx); - *context = (qmckl_context) 0; return QMCKL_SUCCESS; } #+END_SRC *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c + if (qmckl_context_check(new_context) != new_context) { + fprintf(stderr,"qmckl_context_destroy: new_context is invalid\n"); + rc = QMCKL_FAILURE; + } if (new_context == (qmckl_context) 0) { fprintf(stderr,"qmckl_context_destroy: new_context is NULL\n"); rc = QMCKL_FAILURE; } - if (qmckl_context_destroy(&new_context) == QMCKL_FAILURE) { + if (qmckl_context_destroy(new_context) == QMCKL_FAILURE) { fprintf(stderr,"qmckl_context_destroy: Unable to destroy the new_context\n"); rc = QMCKL_FAILURE; } - if (new_context != (qmckl_context) 0) { + if (qmckl_context_check(new_context) == new_context) { + fprintf(stderr,"qmckl_context_destroy: new_context is valid\n"); + rc = QMCKL_FAILURE; + } + if (qmckl_context_check(new_context) != (qmckl_context) 0) { fprintf(stderr,"qmckl_context_destroy: new_context should be NULL\n"); rc = QMCKL_FAILURE; } @@ -272,7 +310,7 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context *context) { } #+END_SRC - + * Precision The following functions set and get the expected required precision From 97cfd4d2b507b82d4b76d777bec9837ed82fa034 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 16 Oct 2020 23:56:22 +0200 Subject: [PATCH 10/61] Added qmckl_malloc --- src/README.org | 1 + src/qmckl.org | 2 + src/qmckl_context.org | 11 +++-- src/qmckl_memory.org | 94 +++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 102 insertions(+), 6 deletions(-) create mode 100644 src/qmckl_memory.org diff --git a/src/README.org b/src/README.org index fac2ecf..07d3de5 100644 --- a/src/README.org +++ b/src/README.org @@ -182,6 +182,7 @@ rm ${nb}.md ** Documentation - [[qmckl.org][Main QMCkl header file]] +- [[qmckl_memory.org][Memory management]] - [[qmckl_context.org][Context]] ** Acknowledgments diff --git a/src/qmckl.org b/src/qmckl.org index 0a400d5..c5dedc8 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -42,6 +42,8 @@ typedef int qmckl_exit_code; header files. #+BEGIN_SRC C :tangle qmckl.h +#include +#include "qmckl_memory.h" #include "qmckl_context.h" #+END_SRC diff --git a/src/qmckl_context.org b/src/qmckl_context.org index f98b481..9a56cb6 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -19,13 +19,12 @@ C than in Fortran. *** Source #+BEGIN_SRC C :tangle qmckl_context.c -#include /* malloc */ -#include "qmckl_context.h" +#include "qmckl.h" #+END_SRC *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c -#include "qmckl_context.h" +#include "qmckl.h" #include int main() { qmckl_exit_code rc; /* return code */ @@ -112,7 +111,7 @@ qmckl_context qmckl_context_create() { qmckl_context_struct* context; - context = (qmckl_context_struct*) malloc (sizeof(qmckl_context_struct)); + context = (qmckl_context_struct*) qmckl_malloc (sizeof(qmckl_context_struct)); if (context == NULL) { return (qmckl_context) 0; } @@ -166,7 +165,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { return (qmckl_context) 0; } - new_context = (qmckl_context_struct*) malloc (sizeof(qmckl_context_struct)); + new_context = (qmckl_context_struct*) qmckl_malloc (sizeof(qmckl_context_struct)); if (new_context == NULL) { return (qmckl_context) 0; } @@ -277,7 +276,7 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { if (ctx == NULL) return QMCKL_FAILURE; ctx->tag = INVALID_TAG; - free(ctx); + qmckl_free(ctx); return QMCKL_SUCCESS; } #+END_SRC diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org new file mode 100644 index 0000000..e1d5051 --- /dev/null +++ b/src/qmckl_memory.org @@ -0,0 +1,94 @@ +# -*- mode: org -*- +# vim: syntax=c +#+TITLE: Memory management + +We override the allocation functions to enable the possibility of +optimized libraries to fine-tune the memory allocation. + +3 files are produced: +- a header file : =qmckl_memory.h= +- a source file : =qmckl_memory.c= +- a test file : =test_qmckl_memory.c= + +*** Header + #+BEGIN_SRC C :tangle qmckl_memory.h +#ifndef QMCKL_MEMORY_H +#define QMCKL_MEMORY_H +#include "qmckl.h" + #+END_SRC + +*** Source + #+BEGIN_SRC C :tangle qmckl_memory.c +#include +#include "qmckl_memory.h" + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_memory.c +#include "qmckl_memory.h" +#include +int main() { + qmckl_exit_code rc; /* return code */ + rc = QMCKL_SUCCESS; + #+END_SRC + +** =qmckl_malloc= + Analogous of =malloc, but passing signed 64-bit integers as argument.= +*** Header + #+BEGIN_SRC C :tangle qmckl_memory.h +void* qmckl_malloc(long long int size); + #+END_SRC + +*** Source + #+BEGIN_SRC C :tangle qmckl_memory.c +void* qmckl_malloc(long long int size) { + return malloc( (size_t) size ); +} + + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_memory.c + int *a; + a = (int*) qmckl_malloc(3*sizeof(int)); + a[0] = 1; + a[1] = 2; + a[2] = 3; + if ( a[0] != 1 || a[1] != 2 || a[2] != 3 ) { + fprintf(stderr,"qmckl_malloc: Invalid data\n"); + rc = QMCKL_FAILURE; + } + + #+END_SRC + +** =qmckl_free= + +*** Header + #+BEGIN_SRC C :tangle qmckl_memory.h +void qmckl_free(void *ptr); + #+END_SRC + +*** Source + #+BEGIN_SRC C :tangle qmckl_memory.c +void qmckl_free(void *ptr) { + free(ptr); +} + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_memory.c + qmckl_free(a); + #+END_SRC + +* End of files + +*** Header + #+BEGIN_SRC C :tangle qmckl_memory.h +#endif + #+END_SRC + +*** Test + #+BEGIN_SRC C :tangle test_qmckl_memory.c + return QMCKL_SUCCESS; +} + #+END_SRC From 456c6fc10065ef32d4b125ddc6f7d967e9b4a08e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 17 Oct 2020 00:00:57 +0200 Subject: [PATCH 11/61] Updated Makefile --- src/Makefile | 2 +- src/org_to_code.sh | 38 -------------------------------------- 2 files changed, 1 insertion(+), 39 deletions(-) delete mode 100755 src/org_to_code.sh diff --git a/src/Makefile b/src/Makefile index fa56849..dc00079 100644 --- a/src/Makefile +++ b/src/Makefile @@ -17,7 +17,7 @@ libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated clean: - rm -f qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so + rm -f qmckl.h test_qmckl_*.c test_qmckl_*.f90 qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh ./create_makefile.sh $(ORG_SOURCE_FILES) diff --git a/src/org_to_code.sh b/src/org_to_code.sh deleted file mode 100755 index 4afe7d8..0000000 --- a/src/org_to_code.sh +++ /dev/null @@ -1,38 +0,0 @@ -#!/usr/bin/env bash - -if [[ -z $1 ]] ; then - echo "Usage: $0 " - exit 1; -fi - -if [[ -z $6 ]] ; then -# Few file to tangle - - for INPUT in $@ ; do - emacs \ - --quick \ - --no-init-file \ - --batch \ - --eval "(require 'org)" \ - --eval "(org-babel-tangle-file \"$INPUT\")" - done - -else -# Multiple files to tangle, so we use the emacs server to speed up thing - - emacsclient -a "" \ - --socket-name=org_to_code \ - --eval "(require 'org)" - - for INPUT in $@ ; do - emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval "(org-babel-tangle-file \"$INPUT\")" - done - - emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval '(kill-emacs)' -fi From 722d6dd54060a045919440b68576a4fe79755378 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 17 Oct 2020 00:28:49 +0200 Subject: [PATCH 12/61] Make test --- .gitmodules | 3 +++ README.md | 9 ++++++++- munit | 1 + src/Makefile | 3 +++ src/create_makefile.sh | 15 +++++++++++++++ src/qmckl_context.org | 2 +- src/qmckl_memory.org | 2 +- 7 files changed, 32 insertions(+), 3 deletions(-) create mode 100644 .gitmodules create mode 160000 munit diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 0000000..8ad4907 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "munit"] + path = munit + url = https://github.com/nemequ/munit/ diff --git a/README.md b/README.md index 71f31d0..e64cfb3 100644 --- a/README.md +++ b/README.md @@ -13,9 +13,16 @@ See the [source code](https://github.com/TREX-CoE/qmckl/tree/main/src) to read the documentation. +To clone the repository, use: +``` +git clone --recursive https://github.com/TREX-CoE/qmckl.git +``` +to dowload also the [munit](https://github.com/nemequ/munit) unit testing +framework. + ------------------------------ ![European flag](https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg) [TREX: Targeting Real Chemical Accuracy at the Exascale](https://trex-coe.eu) project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. - + diff --git a/munit b/munit new file mode 160000 index 0000000..fbbdf14 --- /dev/null +++ b/munit @@ -0,0 +1 @@ +Subproject commit fbbdf1467eb0d04a6ee465def2e529e4c87f2118 diff --git a/src/Makefile b/src/Makefile index dc00079..1f7b532 100644 --- a/src/Makefile +++ b/src/Makefile @@ -16,6 +16,9 @@ OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated +test: Makefile.generated + $(MAKE) -f Makefile.generated test + clean: rm -f qmckl.h test_qmckl_*.c test_qmckl_*.f90 qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so diff --git a/src/create_makefile.sh b/src/create_makefile.sh index 66b40dc..7562bba 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -35,6 +35,12 @@ for i in $(ls qmckl_*.f90) ; do OBJECTS="${OBJECTS} ${FILE}.o" done >> $OUTPUT +TESTS="" +for i in $(ls test_*.c) ; do + FILE=${i%.c} + TESTS="${TESTS} ${FILE}" +done >> $OUTPUT + # Write the Makefile @@ -45,6 +51,7 @@ CFLAGS=$CFLAGS FC=$FC FFLAGS=$FFLAGS OBJECT_FILES=$OBJECTS +TESTS=$TESTS libqmckl.so: \$(OBJECT_FILES) \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so @@ -55,6 +62,13 @@ libqmckl.so: \$(OBJECT_FILES) %.o: %.f90 \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o +test_%: test_%.c + \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ + -I../munit/ ../munit/munit.c test_\$*.c -lqmckl -o test_\$* + +test: libqmckl.so \$(TESTS) + +.PHONY: test EOF for i in $(ls qmckl_*.c) ; do @@ -67,3 +81,4 @@ for i in $(ls qmckl_*.f90) ; do echo "${FILE}.o: ${FILE}.f90" done >> $OUTPUT + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 9a56cb6..b2706da 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -441,7 +441,7 @@ int qmckl_context_get_range(const qmckl_context context) { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c - return QMCKL_SUCCESS; + return rc; } #+END_SRC diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index e1d5051..bfb9c68 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -89,6 +89,6 @@ void qmckl_free(void *ptr) { *** Test #+BEGIN_SRC C :tangle test_qmckl_memory.c - return QMCKL_SUCCESS; + return rc; } #+END_SRC From fe3f30ebba37e9a5332e8c67509f1dccd34b4d99 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 17 Oct 2020 01:10:54 +0200 Subject: [PATCH 13/61] Introduced munit for testing --- src/qmckl_context.org | 103 ++++++++++++++---------------------------- src/qmckl_memory.org | 33 +++++++++----- 2 files changed, 57 insertions(+), 79 deletions(-) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index b2706da..77f8558 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -24,11 +24,9 @@ C than in Fortran. *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c -#include "qmckl.h" -#include -int main() { - qmckl_exit_code rc; /* return code */ - rc = QMCKL_SUCCESS; +#include "qmckl.h" +#include "munit.h" +static MunitResult test_qmckl_context() { #+END_SRC * Context @@ -128,14 +126,8 @@ qmckl_context qmckl_context_create() { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c context = qmckl_context_create(); - if (context == (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_create\n"); - rc = QMCKL_FAILURE; - } - if ( qmckl_context_check(context) != context) { - fprintf(stderr,"qmckl_context_create: Invalid context\n"); - rc = QMCKL_FAILURE; - } + munit_assert_long( context, !=, (qmckl_context) 0); + munit_assert_long( qmckl_context_check(context), ==, context); #+END_SRC ** =qmckl_context_copy= @@ -185,19 +177,9 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); - if (new_context == (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_copy: Allocation failure\n"); - rc = QMCKL_FAILURE; - } - if (new_context == context ) { - fprintf(stderr,"qmckl_context_copy: Same pointer\n"); - rc = QMCKL_FAILURE; - } - if ( qmckl_context_check(new_context) != new_context) { - fprintf(stderr,"qmckl_context_copy: No access to data\n"); - rc = QMCKL_FAILURE; - } - + munit_assert_long(new_context, !=, (qmckl_context) 0); + munit_assert_long(new_context, !=, context); + munit_assert_long(qmckl_context_check(new_context), ==, new_context); #+END_SRC ** =qmckl_context_previous= @@ -231,22 +213,10 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c - if (qmckl_context_previous(new_context) == (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_previous: Null pointer\n"); - rc = QMCKL_FAILURE; - } - if (qmckl_context_previous(new_context) != context) { - fprintf(stderr,"qmckl_context_previous: Wrong pointer\n"); - rc = QMCKL_FAILURE; - } - if (qmckl_context_previous(context) != (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_previous: Expected null pointer (1)\n"); - rc = QMCKL_FAILURE; - } - if (qmckl_context_previous((qmckl_context) 0) != (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_previous: Expected null pointer (2)\n"); - rc = QMCKL_FAILURE; - } + munit_assert_long(qmckl_context_previous(new_context), !=, (qmckl_context) 0); + munit_assert_long(qmckl_context_previous(new_context), ==, context); + munit_assert_long(qmckl_context_previous(context), ==, (qmckl_context) 0); + munit_assert_long(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); #+END_SRC ** =qmckl_context_destroy= @@ -283,30 +253,12 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c - if (qmckl_context_check(new_context) != new_context) { - fprintf(stderr,"qmckl_context_destroy: new_context is invalid\n"); - rc = QMCKL_FAILURE; - } - if (new_context == (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_destroy: new_context is NULL\n"); - rc = QMCKL_FAILURE; - } - if (qmckl_context_destroy(new_context) == QMCKL_FAILURE) { - fprintf(stderr,"qmckl_context_destroy: Unable to destroy the new_context\n"); - rc = QMCKL_FAILURE; - } - if (qmckl_context_check(new_context) == new_context) { - fprintf(stderr,"qmckl_context_destroy: new_context is valid\n"); - rc = QMCKL_FAILURE; - } - if (qmckl_context_check(new_context) != (qmckl_context) 0) { - fprintf(stderr,"qmckl_context_destroy: new_context should be NULL\n"); - rc = QMCKL_FAILURE; - } - if (qmckl_context_destroy((qmckl_context) 0) == QMCKL_SUCCESS) { - fprintf(stderr,"qmckl_context_destroy: Failure expected with NULL pointer\n"); - rc = QMCKL_FAILURE; - } + munit_assert_long(qmckl_context_check(new_context), ==, new_context); + munit_assert_long(new_context, !=, (qmckl_context) 0); + munit_assert_int(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); + munit_assert_long(qmckl_context_check(new_context), !=, new_context); + munit_assert_long(qmckl_context_check(new_context), ==, (qmckl_context) 0); + munit_assert_long(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); #+END_SRC @@ -441,7 +393,22 @@ int qmckl_context_get_range(const qmckl_context context) { *** Test #+BEGIN_SRC C :tangle test_qmckl_context.c - return rc; -} + return MUNIT_OK; +} + +int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { + static MunitTest test_suite_tests[] = + { + { (char*) "qmckl_context", test_qmckl_context, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL }, + { NULL, NULL, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL } + }; + + static const MunitSuite test_suite = + { + (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE + }; + + return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); +} #+END_SRC diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index bfb9c68..afda701 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -25,11 +25,9 @@ optimized libraries to fine-tune the memory allocation. *** Test #+BEGIN_SRC C :tangle test_qmckl_memory.c -#include "qmckl_memory.h" -#include -int main() { - qmckl_exit_code rc; /* return code */ - rc = QMCKL_SUCCESS; +#include "qmckl.h" +#include "munit.h" +static MunitResult test_qmckl_memory() { #+END_SRC ** =qmckl_malloc= @@ -54,11 +52,9 @@ void* qmckl_malloc(long long int size) { a[0] = 1; a[1] = 2; a[2] = 3; - if ( a[0] != 1 || a[1] != 2 || a[2] != 3 ) { - fprintf(stderr,"qmckl_malloc: Invalid data\n"); - rc = QMCKL_FAILURE; - } - + munit_assert_int(a[0], ==, 1); + munit_assert_int(a[1], ==, 2); + munit_assert_int(a[2], ==, 3); #+END_SRC ** =qmckl_free= @@ -89,6 +85,21 @@ void qmckl_free(void *ptr) { *** Test #+BEGIN_SRC C :tangle test_qmckl_memory.c - return rc; + return MUNIT_OK; +} + +int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { + static MunitTest test_suite_tests[] = + { + { (char*) "qmckl_memory", test_qmckl_memory, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL }, + { NULL, NULL, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL } + }; + + static const MunitSuite test_suite = + { + (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE + }; + + return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); } #+END_SRC From 3377b056df2d2bac19ab228a6ef656ef2772f2f4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 17 Oct 2020 01:14:57 +0200 Subject: [PATCH 14/61] Added tests to CI --- .github/workflows/test-build.yml | 2 +- src/create_makefile.sh | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index 7d22a09..d616b1e 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -16,4 +16,4 @@ jobs: - name: install dependencies run: sudo apt-get install emacs - name: make - run: make -C src/ + run: make -C src/ test diff --git a/src/create_makefile.sh b/src/create_makefile.sh index 7562bba..08fa2b5 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -67,6 +67,7 @@ test_%: test_%.c -I../munit/ ../munit/munit.c test_\$*.c -lqmckl -o test_\$* test: libqmckl.so \$(TESTS) + for i in \$(TESTS) ; do ./\$\$i ; done .PHONY: test EOF From c0a21d568acf85b9687396ce0a58ab4e1c2c461d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 17 Oct 2020 01:20:11 +0200 Subject: [PATCH 15/61] Simplify makefile --- src/Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Makefile b/src/Makefile index 1f7b532..07bfb38 100644 --- a/src/Makefile +++ b/src/Makefile @@ -20,7 +20,7 @@ test: Makefile.generated $(MAKE) -f Makefile.generated test clean: - rm -f qmckl.h test_qmckl_*.c test_qmckl_*.f90 qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so + rm -f qmckl.h test_qmckl_* qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh ./create_makefile.sh $(ORG_SOURCE_FILES) From 8c9a10cae6deb088c1ece2054e385712f11f371f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 17 Oct 2020 01:28:15 +0200 Subject: [PATCH 16/61] Fixing workflow with submodules --- .github/workflows/test-build.yml | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index d616b1e..3f9a036 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -15,5 +15,23 @@ jobs: - uses: actions/checkout@v2 - name: install dependencies run: sudo apt-get install emacs + - name: make + run: make -C src/ + + test: + + runs-on: ubuntu-latest + + steps: + - uses: actions/checkout@v2 + - name: install dependencies + run: sudo apt-get install emacs + - name: Checkout submodules using a PAT + run: | + git config --file .gitmodules --get-regexp url | while read url; do + git config --file=.gitmodules $(echo "$url" | sed -E "s/git@github.com:|https:\/\/github.com\//https:\/\/${{ secrets.CI_PAT }}:${{ secrets.CI_PAT }}@github.com\//") + done + git submodule sync + git submodule update --init --recursive - name: make run: make -C src/ test From 5f5465eaf9dcce5f2617c7bd1a43a09e792bad9d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 21 Oct 2020 19:50:18 +0200 Subject: [PATCH 17/61] Merge tests into single exe --- src/.gitignore | 1 + src/Makefile | 8 ++-- src/create_makefile.sh | 20 ++++++---- src/qmckl_context.org | 85 +++++++++++++++++------------------------- src/qmckl_memory.org | 38 ++++++------------- src/test_qmckl.org | 79 +++++++++++++++++++++++++++++++++++++++ 6 files changed, 144 insertions(+), 87 deletions(-) create mode 100644 src/test_qmckl.org diff --git a/src/.gitignore b/src/.gitignore index c36740c..2cb97cf 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -4,3 +4,4 @@ *~ *.so Makefile.generated +test_qmckl diff --git a/src/Makefile b/src/Makefile index 07bfb38..8b58bd5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,5 +1,5 @@ CC=gcc -CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g +CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g FC=gfortran FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan @@ -7,16 +7,16 @@ FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics export CC CFLAGS FC FFLAGS -ORG_SOURCE_FILES=$(wildcard qmckl*.org) +ORG_SOURCE_FILES=$(wildcard qmckl*.org) test_qmckl.org OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) -.PHONY: clean +.PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated -test: Makefile.generated +test: Makefile.generated $(MAKE) -f Makefile.generated test clean: diff --git a/src/create_makefile.sh b/src/create_makefile.sh index 08fa2b5..e70f160 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -36,8 +36,8 @@ for i in $(ls qmckl_*.f90) ; do done >> $OUTPUT TESTS="" -for i in $(ls test_*.c) ; do - FILE=${i%.c} +for i in $(ls test_qmckl_*.c) ; do + FILE=${i} TESTS="${TESTS} ${FILE}" done >> $OUTPUT @@ -46,7 +46,7 @@ done >> $OUTPUT cat << EOF > $OUTPUT CC=$CC -CFLAGS=$CFLAGS +CFLAGS=$CFLAGS -I../munit/ FC=$FC FFLAGS=$FFLAGS @@ -62,12 +62,13 @@ libqmckl.so: \$(OBJECT_FILES) %.o: %.f90 \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o -test_%: test_%.c +test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) + echo \$(TESTS) \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ - -I../munit/ ../munit/munit.c test_\$*.c -lqmckl -o test_\$* + ../munit/munit.c \$(TESTS) -lqmckl test_qmckl.c -o test_qmckl -test: libqmckl.so \$(TESTS) - for i in \$(TESTS) ; do ./\$\$i ; done +test: test_qmckl + ./test_qmckl .PHONY: test EOF @@ -82,4 +83,9 @@ for i in $(ls qmckl_*.f90) ; do echo "${FILE}.o: ${FILE}.f90" done >> $OUTPUT +for i in $(ls test_qmckl_*.c) ; do + FILE=${i%.c} + echo "${FILE}.o: ${FILE}.c qmckl.h" +done >> $OUTPUT + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 77f8558..37de324 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -11,22 +11,22 @@ C than in Fortran. - a test file : =test_qmckl_context.c= *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h #ifndef QMCKL_CONTEXT_H #define QMCKL_CONTEXT_H #include "qmckl.h" #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c #include "qmckl.h" #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c #include "qmckl.h" #include "munit.h" -static MunitResult test_qmckl_context() { +MunitResult test_qmckl_context() { #+END_SRC * Context @@ -39,13 +39,13 @@ static MunitResult test_qmckl_context() { A value of 0 for the context is equivalent to a NULL pointer. *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h /* 64-bit integer */ typedef long long int qmckl_context ; #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; unsigned int tag; @@ -62,7 +62,7 @@ typedef struct qmckl_context_struct { *** Test We declare here the variables used in the tests. - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c qmckl_context context; qmckl_context new_context; #+END_SRC @@ -74,12 +74,12 @@ typedef struct qmckl_context_struct { Returns the input =qmckl_context= if the context is valid, 0 otherwise. *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_check(qmckl_context context) ; #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_check(qmckl_context context) { qmckl_context_struct * ctx; @@ -99,12 +99,12 @@ qmckl_context qmckl_context_check(qmckl_context context) { - Returns 0 upon failure to allocate the internal data structure *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_create(); #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_create() { qmckl_context_struct* context; @@ -124,7 +124,7 @@ qmckl_context qmckl_context_create() { #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c context = qmckl_context_create(); munit_assert_long( context, !=, (qmckl_context) 0); munit_assert_long( qmckl_context_check(context), ==, context); @@ -139,12 +139,12 @@ qmckl_context qmckl_context_create() { for the new context *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_copy(const qmckl_context context); #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_copy(const qmckl_context context) { qmckl_context_struct* old_context; @@ -175,7 +175,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); munit_assert_long(new_context, !=, (qmckl_context) 0); munit_assert_long(new_context, !=, context); @@ -190,12 +190,12 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { - Returns 0 for the 0-valued context *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_previous(const qmckl_context context); #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_previous(const qmckl_context context) { qmckl_context checked_context; @@ -212,7 +212,7 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c munit_assert_long(qmckl_context_previous(new_context), !=, (qmckl_context) 0); munit_assert_long(qmckl_context_previous(new_context), ==, context); munit_assert_long(qmckl_context_previous(context), ==, (qmckl_context) 0); @@ -228,12 +228,12 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { - Fails if the the pointer is not a valid context *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_destroy(qmckl_context context); #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_exit_code qmckl_context_destroy(qmckl_context context) { qmckl_context_struct* ctx; @@ -252,7 +252,7 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c munit_assert_long(qmckl_context_check(new_context), ==, new_context); munit_assert_long(new_context, !=, (qmckl_context) 0); munit_assert_int(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); @@ -274,11 +274,11 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { ** =qmckl_context_update_precision= - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision); #+END_SRC - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision) { qmckl_context_struct* ctx; @@ -294,11 +294,11 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int #+END_SRC ** =qmckl_context_update_range= - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range); #+END_SRC - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range) { qmckl_context_struct* ctx; @@ -317,11 +317,11 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int rang ** =qmckl_context_set_precision= - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_set_precision(const qmckl_context context, int precision); #+END_SRC - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context new_context; @@ -335,11 +335,11 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int #+END_SRC ** =qmckl_context_set_range= - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_set_range(const qmckl_context context, int range); #+END_SRC - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_set_range(const qmckl_context context, int range) { qmckl_context new_context; @@ -356,11 +356,11 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, int range) { ** =qmckl_context_get_precision= - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h int qmckl_context_get_precision(const qmckl_context context); #+END_SRC - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c int qmckl_context_get_precision(const qmckl_context context) { qmckl_context_struct* ctx; ctx = (qmckl_context_struct*) context; @@ -370,11 +370,11 @@ int qmckl_context_get_precision(const qmckl_context context) { ** =qmckl_context_get_range= - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h int qmckl_context_get_range(const qmckl_context context); #+END_SRC - #+BEGIN_SRC C :tangle qmckl_context.c + #+BEGIN_SRC C :comments link :tangle qmckl_context.c int qmckl_context_get_range(const qmckl_context context) { qmckl_context_struct* ctx; ctx = (qmckl_context_struct*) context; @@ -387,28 +387,13 @@ int qmckl_context_get_range(const qmckl_context context) { * End of files *** Header - #+BEGIN_SRC C :tangle qmckl_context.h + #+BEGIN_SRC C :comments link :tangle qmckl_context.h #endif #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c return MUNIT_OK; } - -int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { - static MunitTest test_suite_tests[] = - { - { (char*) "qmckl_context", test_qmckl_context, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL }, - { NULL, NULL, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL } - }; - - static const MunitSuite test_suite = - { - (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE - }; - - return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); -} #+END_SRC diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index afda701..5d7b49b 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -11,34 +11,34 @@ optimized libraries to fine-tune the memory allocation. - a test file : =test_qmckl_memory.c= *** Header - #+BEGIN_SRC C :tangle qmckl_memory.h + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h #ifndef QMCKL_MEMORY_H #define QMCKL_MEMORY_H #include "qmckl.h" #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_memory.c + #+BEGIN_SRC C :comments link :tangle qmckl_memory.c #include #include "qmckl_memory.h" #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_memory.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c #include "qmckl.h" #include "munit.h" -static MunitResult test_qmckl_memory() { +MunitResult test_qmckl_memory() { #+END_SRC ** =qmckl_malloc= Analogous of =malloc, but passing signed 64-bit integers as argument.= *** Header - #+BEGIN_SRC C :tangle qmckl_memory.h + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h void* qmckl_malloc(long long int size); #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_memory.c + #+BEGIN_SRC C :comments link :tangle qmckl_memory.c void* qmckl_malloc(long long int size) { return malloc( (size_t) size ); } @@ -46,7 +46,7 @@ void* qmckl_malloc(long long int size) { #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_memory.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c int *a; a = (int*) qmckl_malloc(3*sizeof(int)); a[0] = 1; @@ -60,46 +60,32 @@ void* qmckl_malloc(long long int size) { ** =qmckl_free= *** Header - #+BEGIN_SRC C :tangle qmckl_memory.h + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h void qmckl_free(void *ptr); #+END_SRC *** Source - #+BEGIN_SRC C :tangle qmckl_memory.c + #+BEGIN_SRC C :comments link :tangle qmckl_memory.c void qmckl_free(void *ptr) { free(ptr); } #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_memory.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c qmckl_free(a); #+END_SRC * End of files *** Header - #+BEGIN_SRC C :tangle qmckl_memory.h + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h #endif #+END_SRC *** Test - #+BEGIN_SRC C :tangle test_qmckl_memory.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c return MUNIT_OK; } -int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { - static MunitTest test_suite_tests[] = - { - { (char*) "qmckl_memory", test_qmckl_memory, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL }, - { NULL, NULL, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL } - }; - - static const MunitSuite test_suite = - { - (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE - }; - - return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); -} #+END_SRC diff --git a/src/test_qmckl.org b/src/test_qmckl.org new file mode 100644 index 0000000..c814265 --- /dev/null +++ b/src/test_qmckl.org @@ -0,0 +1,79 @@ +#+TITLE: QMCkl test + +This file is the main program of the unit tests. The tests rely on the +$\mu$unit framework, which is provided as a git submodule. + +First, we use a script to find the list of all the produced test files: +#+NAME: test-files +#+BEGIN_SRC sh :exports none :results value +grep BEGIN_SRC *.org | \ + grep test_qmckl_ | \ + rev | \ + cut -d ' ' -f 1 | \ + rev | \ + sort | \ + uniq +#+END_SRC + +#+RESULTS: test-files +| test_qmckl_context.c | +| test_qmckl_memory.c | + +We generate the function headers +#+BEGIN_SRC sh :var files=test-files :exports output :results raw +echo "#+NAME: headers" +echo "#+BEGIN_SRC C :tangle no" +for file in $files +do + routine=${file%.c} + echo "MunitResult ${routine}();" +done +echo "#+END_SRC" +#+END_SRC + +#+RESULTS: +#+NAME: headers +#+BEGIN_SRC C :tangle no +MunitResult test_qmckl_context(); +MunitResult test_qmckl_memory(); +#+END_SRC + +and the required function calls: +#+BEGIN_SRC sh :var files=test-files :exports output :results raw +echo "#+NAME: calls" +echo "#+BEGIN_SRC C :tangle no" +for file in $files +do + routine=${file%.c} + echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," +done +echo "#+END_SRC" +#+END_SRC + +#+RESULTS: +#+NAME: calls +#+BEGIN_SRC C :tangle no + { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, + { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, +#+END_SRC + +#+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c +#include "qmckl.h" +#include "munit.h" +<> + +int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { + static MunitTest test_suite_tests[] = + { +<> + { NULL, NULL, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL } + }; + + static const MunitSuite test_suite = + { + (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE + }; + + return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); +} +#+END_SRC From 150518aef09729bc2de0a7e4de5e91cc1d7da3a3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 22 Oct 2020 00:50:07 +0200 Subject: [PATCH 18/61] Added f90 example file --- src/.gitignore | 1 + src/Makefile | 4 +- src/README.org | 9 ++ src/create_makefile.sh | 4 +- src/qmckl.org | 10 +- src/qmckl_context.org | 112 +++++++++++------------ src/qmckl_distance.org | 201 +++++++++++++++++++++++++++++++++++++++++ src/qmckl_memory.org | 12 ++- src/test_qmckl.org | 7 +- 9 files changed, 291 insertions(+), 69 deletions(-) create mode 100644 src/qmckl_distance.org diff --git a/src/.gitignore b/src/.gitignore index 2cb97cf..1ce56e6 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -1,5 +1,6 @@ *.o *.c +*.f90 *.h *~ *.so diff --git a/src/Makefile b/src/Makefile index 8b58bd5..8aa37d5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -4,8 +4,10 @@ CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g FC=gfortran FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan +LIBS=-lgfortran -lm -export CC CFLAGS FC FFLAGS + +export CC CFLAGS FC FFLAGS LIBS ORG_SOURCE_FILES=$(wildcard qmckl*.org) test_qmckl.org OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) diff --git a/src/README.org b/src/README.org index 07d3de5..59666a7 100644 --- a/src/README.org +++ b/src/README.org @@ -179,11 +179,20 @@ rm ${nb}.md As QMCkl is a general purpose library, multiple algorithms should be implemented adapted to different problem sizes. + +** Rules for the API + + - =stdint= should be used for integers (=int32_t=, =int64_t=) + - integers used for counting should always be =int64_t= + - floats should be by default =double=, unless explicitly mentioned + - pointers are converted to =int64_t= to increase portability + ** Documentation - [[qmckl.org][Main QMCkl header file]] - [[qmckl_memory.org][Memory management]] - [[qmckl_context.org][Context]] +- [[qmckldistance.org][Distance]] ** Acknowledgments diff --git a/src/create_makefile.sh b/src/create_makefile.sh index e70f160..959fdc8 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -53,6 +53,8 @@ FFLAGS=$FFLAGS OBJECT_FILES=$OBJECTS TESTS=$TESTS +LIBS=$LIBS + libqmckl.so: \$(OBJECT_FILES) \$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so @@ -65,7 +67,7 @@ libqmckl.so: \$(OBJECT_FILES) test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) echo \$(TESTS) \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ - ../munit/munit.c \$(TESTS) -lqmckl test_qmckl.c -o test_qmckl + ../munit/munit.c \$(TESTS) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl test: test_qmckl ./test_qmckl diff --git a/src/qmckl.org b/src/qmckl.org index c5dedc8..f1065f5 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -8,6 +8,8 @@ other C header files. It is the main entry point to the library. #+BEGIN_SRC C :tangle qmckl.h #ifndef QMCKL_H #define QMCKL_H +#include +#include #+END_SRC * Constants @@ -21,7 +23,9 @@ other C header files. It is the main entry point to the library. #define QMCKL_SUCCESS 0 #define QMCKL_FAILURE 1 -typedef int qmckl_exit_code; +typedef int32_t qmckl_exit_code; +typedef int64_t qmckl_context ; + #+END_SRC @@ -42,9 +46,11 @@ typedef int qmckl_exit_code; header files. #+BEGIN_SRC C :tangle qmckl.h -#include + #include "qmckl_memory.h" #include "qmckl_context.h" + +#include "qmckl_distance.h" #+END_SRC * End of header diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 37de324..a2ea884 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -6,11 +6,11 @@ This file is written in C because it is more natural to express the context in C than in Fortran. 3 files are produced: -- a header file : =qmckl_context.h= -- a source file : =qmckl_context.c= -- a test file : =test_qmckl_context.c= +- a header file : =qmckl_context.h= +- a source file : =qmckl_context.c= +- a test file : =test_qmckl_context.c= -*** Header +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h #ifndef QMCKL_CONTEXT_H #define QMCKL_CONTEXT_H @@ -24,9 +24,9 @@ C than in Fortran. *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c -#include "qmckl.h" -#include "munit.h" -MunitResult test_qmckl_context() { +#include "qmckl.h" +#include "munit.h" +MunitResult test_qmckl_context() { #+END_SRC * Context @@ -38,25 +38,19 @@ MunitResult test_qmckl_context() { into a 64-bit signed integer, defined in the =qmckl_context= type. A value of 0 for the context is equivalent to a NULL pointer. -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -/* 64-bit integer */ -typedef long long int qmckl_context ; - #+END_SRC - *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; - unsigned int tag; - int precision; - int range; + uint32_t tag; + int32_t precision; + int32_t range; } qmckl_context_struct; #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF #+END_SRC - + The tag is used internally to check if the memory domain pointed by a pointer is a valid context. @@ -67,20 +61,20 @@ typedef struct qmckl_context_struct { qmckl_context new_context; #+END_SRC - + ** =qmckl_context_check= - + Checks if the domain pointed by the pointer is a valid context. Returns the input =qmckl_context= if the context is valid, 0 otherwise. *** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_check(qmckl_context context) ; +qmckl_context qmckl_context_check(const qmckl_context context) ; #+END_SRC - + *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_context qmckl_context_check(qmckl_context context) { +qmckl_context qmckl_context_check(const qmckl_context context) { qmckl_context_struct * ctx; if (context == (qmckl_context) 0) return (qmckl_context) 0; @@ -88,10 +82,10 @@ qmckl_context qmckl_context_check(qmckl_context context) { ctx = (qmckl_context_struct*) context; if (ctx->tag != VALID_TAG) return (qmckl_context) 0; - return context; + return context; } #+END_SRC - + ** =qmckl_context_create= To create a new context, use =qmckl_context_create()=. @@ -109,7 +103,7 @@ qmckl_context qmckl_context_create() { qmckl_context_struct* context; - context = (qmckl_context_struct*) qmckl_malloc (sizeof(qmckl_context_struct)); + context = (qmckl_context_struct*) qmckl_malloc ((qmckl_context) 0, sizeof(qmckl_context_struct)); if (context == NULL) { return (qmckl_context) 0; } @@ -122,12 +116,12 @@ qmckl_context qmckl_context_create() { return (qmckl_context) context; } #+END_SRC - + *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c context = qmckl_context_create(); - munit_assert_long( context, !=, (qmckl_context) 0); - munit_assert_long( qmckl_context_check(context), ==, context); + munit_assert_int64( context, !=, (qmckl_context) 0); + munit_assert_int64( qmckl_context_check(context), ==, context); #+END_SRC ** =qmckl_context_copy= @@ -157,7 +151,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { return (qmckl_context) 0; } - new_context = (qmckl_context_struct*) qmckl_malloc (sizeof(qmckl_context_struct)); + new_context = (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); if (new_context == NULL) { return (qmckl_context) 0; } @@ -177,13 +171,13 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); - munit_assert_long(new_context, !=, (qmckl_context) 0); - munit_assert_long(new_context, !=, context); - munit_assert_long(qmckl_context_check(new_context), ==, new_context); + munit_assert_int64(new_context, !=, (qmckl_context) 0); + munit_assert_int64(new_context, !=, context); + munit_assert_int64(qmckl_context_check(new_context), ==, new_context); #+END_SRC ** =qmckl_context_previous= - + Returns the previous context - On success, returns the ancestor of the current context - Returns 0 for the initial context @@ -213,20 +207,20 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - munit_assert_long(qmckl_context_previous(new_context), !=, (qmckl_context) 0); - munit_assert_long(qmckl_context_previous(new_context), ==, context); - munit_assert_long(qmckl_context_previous(context), ==, (qmckl_context) 0); - munit_assert_long(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); + munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); + munit_assert_int64(qmckl_context_previous(new_context), ==, context); + munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); + munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); #+END_SRC ** =qmckl_context_destroy= - + Destroys the current context, leaving the ancestors untouched. - Succeeds if the current context is properly destroyed - Fails otherwise - Fails if the 0-valued context is given in argument - Fails if the the pointer is not a valid context - + *** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_destroy(qmckl_context context); @@ -238,7 +232,7 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { qmckl_context_struct* ctx; qmckl_context checked_context; - + checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) return QMCKL_FAILURE; @@ -253,15 +247,15 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - munit_assert_long(qmckl_context_check(new_context), ==, new_context); - munit_assert_long(new_context, !=, (qmckl_context) 0); - munit_assert_int(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); - munit_assert_long(qmckl_context_check(new_context), !=, new_context); - munit_assert_long(qmckl_context_check(new_context), ==, (qmckl_context) 0); - munit_assert_long(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); + munit_assert_int64(qmckl_context_check(new_context), ==, new_context); + munit_assert_int64(new_context, !=, (qmckl_context) 0); + munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); + munit_assert_int64(qmckl_context_check(new_context), !=, new_context); + munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); + munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); #+END_SRC - + * Precision The following functions set and get the expected required precision @@ -275,11 +269,11 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { ** =qmckl_context_update_precision= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision); +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision) { +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { qmckl_context_struct* ctx; if (precision < 2) return QMCKL_FAILURE; @@ -295,11 +289,11 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int ** =qmckl_context_update_range= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range); +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); #+END_SRC - + #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range) { +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { qmckl_context_struct* ctx; if (range < 2) return QMCKL_FAILURE; @@ -318,7 +312,7 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int rang ** =qmckl_context_set_precision= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_set_precision(const qmckl_context context, int precision); +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC #+BEGIN_SRC C :comments link :tangle qmckl_context.c @@ -336,11 +330,11 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int ** =qmckl_context_set_range= #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_set_range(const qmckl_context context, int range); +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_context qmckl_context_set_range(const qmckl_context context, int range) { +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context; new_context = qmckl_context_copy(context); @@ -353,7 +347,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, int range) { #+END_SRC - + ** =qmckl_context_get_precision= #+BEGIN_SRC C :comments link :tangle qmckl_context.h @@ -382,7 +376,7 @@ int qmckl_context_get_range(const qmckl_context context) { } #+END_SRC - + * End of files @@ -393,7 +387,7 @@ int qmckl_context_get_range(const qmckl_context context) { *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - return MUNIT_OK; -} + return MUNIT_OK; +} #+END_SRC diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org new file mode 100644 index 0000000..d3d76e2 --- /dev/null +++ b/src/qmckl_distance.org @@ -0,0 +1,201 @@ +# -*- mode: org -*- +# vim: syntax=c +#+TITLE: Computation of distances + +Function for the computation of distances between particles. + +3 files are produced: +- a header file : =qmckl_distance.h= +- a source file : =qmckl_distance.f90= +- a test file : =test_qmckl_distance.c= + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_distance.h +#ifndef QMCKL_DISTANCE_H +#define QMCKL_DISTANCE_H +#include "qmckl_context.h" + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c +#include +#include "qmckl.h" +#include "munit.h" +MunitResult test_qmckl_distance() { + qmckl_context context; + int64_t m, n, LDA, LDB, LDC; + double *A, *B, *C ; + int i, j; + + context = qmckl_context_create(); + + m = 5; + n = 6; + LDA = 6; + LDB = 10; + LDC = 5; + + A = (double*) qmckl_malloc (context, LDA*4*sizeof(double)); + B = (double*) qmckl_malloc (context, LDB*3*sizeof(double)); + C = (double*) qmckl_malloc (context, LDC*n*sizeof(double)); + + for (j=0 ; j<3 ; j++) { + for (i=0 ; i 0 + - =n= > 0 + - =LDA= >= m + - =LDB= >= n + - =LDC= >= m + - =A= is allocated with at least $3 \times m \times 8$ bytes + - =B= is allocated with at least $3 \times n \times 8$ bytes + - =C= is allocated with at least $m \times n \times 8$ bytes + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_distance.h +qmckl_exit_code qmckl_distance_sq(qmckl_context context, + int64_t m, int64_t n, + double *A, int64_t LDA, + double *B, int64_t LDB, + double *C, int64_t LDC); + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 +integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: m, n + integer (c_int64_t) , intent(in) , value :: LDA + real (c_double) , intent(in) :: A(LDA,3) + integer (c_int64_t) , intent(in) , value :: LDB + real (c_double) , intent(in) :: B(LDB,3) + integer (c_int64_t) , intent(in) , value :: LDC + real (c_double) , intent(out) :: C(LDC,n) + + integer (c_int64_t) :: i,j + real (c_double) :: x, y, z + + info = 0 + + if (context == 0_8) then + info = -1 + return + endif + + if (m <= 0_8) then + info = -2 + return + endif + + if (n <= 0_8) then + info = -3 + return + endif + + if (LDA < m) then + info = -4 + return + endif + + if (LDB < n) then + info = -5 + return + endif + + if (LDC < m) then + info = -6 + return + endif + + do j=1,n + do i=1,m + x = A(i,1) - B(j,1) + y = A(i,2) - B(j,2) + z = A(i,3) - B(j,3) + C(i,j) = x*x + y*y + z*z + end do + end do + +end function qmckl_distance_sq + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + + munit_assert_int64(QMCKL_SUCCESS, ==, + qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) ); + + for (j=0 ; j Date: Thu, 22 Oct 2020 00:51:32 +0200 Subject: [PATCH 19/61] Update README.org --- src/README.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/README.org b/src/README.org index 59666a7..a0f7028 100644 --- a/src/README.org +++ b/src/README.org @@ -192,7 +192,7 @@ rm ${nb}.md - [[qmckl.org][Main QMCkl header file]] - [[qmckl_memory.org][Memory management]] - [[qmckl_context.org][Context]] -- [[qmckldistance.org][Distance]] +- [[qmckl_distance.org][Distance]] ** Acknowledgments From 9fde54922e3f0cf8cab6cb4278694b189fda62d4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 22 Oct 2020 01:24:14 +0200 Subject: [PATCH 20/61] Added make doc --- src/.gitignore | 1 + src/Makefile | 5 +- src/README.org | 285 +++++++++++++++++++++-------------------- src/create_doc.sh | 22 ++++ src/qmckl.org | 7 + src/qmckl_context.org | 12 +- src/qmckl_distance.org | 55 ++++---- src/qmckl_memory.org | 92 +++++++------ src/test_qmckl.org | 7 + 9 files changed, 278 insertions(+), 208 deletions(-) create mode 100755 src/create_doc.sh diff --git a/src/.gitignore b/src/.gitignore index 1ce56e6..90eb50e 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -2,6 +2,7 @@ *.c *.f90 *.h +*.html *~ *.so Makefile.generated diff --git a/src/Makefile b/src/Makefile index 8aa37d5..d5b363d 100644 --- a/src/Makefile +++ b/src/Makefile @@ -21,8 +21,11 @@ libqmckl.so: Makefile.generated test: Makefile.generated $(MAKE) -f Makefile.generated test +doc:$(ORG_SOURCE_FILES) + ./create_doc.sh $(ORG_SOURCE_FILES) + clean: - rm -f qmckl.h test_qmckl_* qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so + rm -f qmckl.h test_qmckl_* qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh ./create_makefile.sh $(ORG_SOURCE_FILES) diff --git a/src/README.org b/src/README.org index a0f7028..5b2ade4 100644 --- a/src/README.org +++ b/src/README.org @@ -1,53 +1,60 @@ -* QMCkl source code +#+TITLE: QMCkl source code documentation -** Introduction +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: - The ultimate goal of QMCkl is to provide a high-performance - implementation of the main kernels of QMC. In this particular - repository, we focus on the definition of the API and the tests, - and on a /pedagogical/ presentation of the algorithms. We expect the - HPC experts to use this repository as a reference for re-writing - optimized libraries. +* Introduction - Literate programming is particularly adapted in this context. - Source files are written in [[ottps://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, to provide useful - comments and LaTex formulas close to the code. There exists multiple - possibilities to convert org-mode files into different formats such as - HTML or pdf. - For a tutorial on literate programming with org-mode, follow - [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. + The ultimate goal of QMCkl is to provide a high-performance + implementation of the main kernels of QMC. In this particular + repository, we focus on the definition of the API and the tests, + and on a /pedagogical/ presentation of the algorithms. We expect the + HPC experts to use this repository as a reference for re-writing + optimized libraries. - The code is extracted from the org files using Emacs as a command-line - tool in the =Makefile=, and then the produced files are compiled. + Literate programming is particularly adapted in this context. + Source files are written in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, to provide useful + comments and LaTex formulas close to the code. There exists multiple + possibilities to convert org-mode files into different formats such as + HTML or pdf. + For a tutorial on literate programming with org-mode, follow + [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. -*** Language used + The code is extracted from the org files using Emacs as a command-line + tool in the =Makefile=, and then the produced files are compiled. - Fortran is one of the most common languages used by the community, - and is simple enough to make the algorithms readable. Hence we - propose in this pedagogical implementation of QMCkl to use Fortran - to express the algorithms. For specific internal functions where - the C language is more natural, C is used. +** Language used - As Fortran modules generate compiler-dependent files, the use of - modules is restricted to the internal use of the library, otherwise - the compliance with C is violated. + Fortran is one of the most common languages used by the community, + and is simple enough to make the algorithms readable. Hence we + propose in this pedagogical implementation of QMCkl to use Fortran + to express the algorithms. For specific internal functions where + the C language is more natural, C is used. - The external dependencies should be kept as small as possible, so - external libraries should be used /only/ if their used is strongly - justified. + As Fortran modules generate compiler-dependent files, the use of + modules is restricted to the internal use of the library, otherwise + the compliance with C is violated. -*** Source code editing + The external dependencies should be kept as small as possible, so + external libraries should be used /only/ if their used is strongly + justified. - Any text editor can be used to edit org-mode files. For a better - user experience Emacs is recommended. - For users hating Emacs, it is good to know that Emacs can behave - like Vim when switched into ``Evil'' mode. There also exists - [[https://www.spacemacs.org][Spacemacs]] which helps the transition for Vim users. +** Source code editing - For users with a preference for Jupyter notebooks, the following - script can convert jupyter notebooks to org-mode files: + Any text editor can be used to edit org-mode files. For a better + user experience Emacs is recommended. + For users hating Emacs, it is good to know that Emacs can behave + like Vim when switched into ``Evil'' mode. There also exists + [[https://www.spacemacs.org][Spacemacs]] which helps the transition for Vim users. - #+BEGIN_SRC sh tangle: nb_to_org.sh + For users with a preference for Jupyter notebooks, the following + script can convert jupyter notebooks to org-mode files: + + #+BEGIN_SRC sh tangle: nb_to_org.sh #!/bin/bash # $ nb_to_org.sh notebook.ipynb # produces the org-mode file notebook.org @@ -58,143 +65,143 @@ nb=$(basename $1 .ipynb) jupyter nbconvert --to markdown ${nb}.ipynb --output ${nb}.md pandoc ${nb}.md -o ${nb}.org rm ${nb}.md - #+END_SRC + #+END_SRC - And pandoc can convert multiple markdown formats into org-mode. + And pandoc can convert multiple markdown formats into org-mode. -*** Writing in Fortran +** Writing in Fortran - The Fortran source files should provide a C interface using - iso-c-binding. The name of the Fortran source files should end - with =_f.f90= to be properly handled by the Makefile. + The Fortran source files should provide a C interface using + iso-c-binding. The name of the Fortran source files should end + with =_f.f90= to be properly handled by the Makefile. -*** Coding style - # TODO: decide on a coding style +** Coding style + # TODO: decide on a coding style - To improve readability, we maintain a consistent coding style in the library. + To improve readability, we maintain a consistent coding style in the library. - - For C source files, we will use __(decide on a coding style)__ - - For Fortran source files, we will use __(decide on a coding style)__ + - For C source files, we will use __(decide on a coding style)__ + - For Fortran source files, we will use __(decide on a coding style)__ - Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. + Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. -** Design of the library +* Design of the library - The proposed API should allow the library to: - - deal with memory transfers between CPU and accelerators - - use different levels of floating-point precision + The proposed API should allow the library to: + - deal with memory transfers between CPU and accelerators + - use different levels of floating-point precision - We chose a multi-layered design with low-level and high-level - functions (see below). + We chose a multi-layered design with low-level and high-level + functions (see below). -*** Naming conventions +** Naming conventions - Use =qmckl_= as a prefix for all exported functions and variables. - All exported header files should have a filename with the prefix - =qmckl_=. + Use =qmckl_= as a prefix for all exported functions and variables. + All exported header files should have a filename with the prefix + =qmckl_=. - If the name of the org-mode file is =xxx.org=, the name of the - produced C files should be =xxx.c= and =xxx.h= and the name of the - produced Fortran files should be =xxx.f90= + If the name of the org-mode file is =xxx.org=, the name of the + produced C files should be =xxx.c= and =xxx.h= and the name of the + produced Fortran files should be =xxx.f90= -*** Application programming interface +** Application programming interface - The application programming interface (API) is designed to be - compatible with the C programming language (not C++), to ensure - that the library will be easily usable in any language. - This implies that only the following data types are allowed in the API: + The application programming interface (API) is designed to be + compatible with the C programming language (not C++), to ensure + that the library will be easily usable in any language. + This implies that only the following data types are allowed in the API: - - 32-bit and 64-bit floats and arrays - - 32-bit and 64-bit integers and arrays - - Pointers should be represented as 64-bit integers (even on - 32-bit architectures) - - ASCII strings are represented as a pointers to a character arrays - and terminated by a zero character (C convention). + - 32-bit and 64-bit floats and arrays + - 32-bit and 64-bit integers and arrays + - Pointers should be represented as 64-bit integers (even on + 32-bit architectures) + - ASCII strings are represented as a pointers to a character arrays + and terminated by a zero character (C convention). - To facilitate the use in other languages than C, we provide some - bindings in other languages in other repositories. + To facilitate the use in other languages than C, we provide some + bindings in other languages in other repositories. - # TODO : Link to repositories for bindings + # TODO : Link to repositories for bindings -*** Global state +** Global state - Global variables should be avoided in the library, because it is - possible that one single program needs to use multiple instances of - the library. To solve this problem we propose to use a pointer to a - =context= variable, built by the library with the - =qmckl_context_create= function. The =context= contains the global - state of the library, and is used as the first argument of many - QMCkl functions. + Global variables should be avoided in the library, because it is + possible that one single program needs to use multiple instances of + the library. To solve this problem we propose to use a pointer to a + =context= variable, built by the library with the + =qmckl_context_create= function. The =context= contains the global + state of the library, and is used as the first argument of many + QMCkl functions. - Modifying the state is done by setters and getters, prefixed - by =qmckl_context_set_= an =qmckl_context_get_=. - When a context variable is modified by a setter, a copy of the old - data structure is made and updated, and the pointer to the new data - structure is returned, such that the old contexts can still be - accessed. - It is also possible to modify the state in an impure fashion, using - the =qmckl_context_update_= functions. - The context and its old versions can be destroyed with - =qmckl_context_destroy=. + Modifying the state is done by setters and getters, prefixed + by =qmckl_context_set_= an =qmckl_context_get_=. + When a context variable is modified by a setter, a copy of the old + data structure is made and updated, and the pointer to the new data + structure is returned, such that the old contexts can still be + accessed. + It is also possible to modify the state in an impure fashion, using + the =qmckl_context_update_= functions. + The context and its old versions can be destroyed with + =qmckl_context_destroy=. -*** Low-level functions +** Low-level functions - Low-level functions are very simple functions which are leaves of the - function call tree (they don't call any other QMCkl function). + Low-level functions are very simple functions which are leaves of the + function call tree (they don't call any other QMCkl function). - This functions are /pure/, and unaware of the QMCkl =context=. They are - not allowed to allocate/deallocate memory, and if they need - temporary memory it should be provided in input. + This functions are /pure/, and unaware of the QMCkl =context=. They are + not allowed to allocate/deallocate memory, and if they need + temporary memory it should be provided in input. -*** High-level functions +** High-level functions - High-level functions are at the top of the function call tree. - They are able to choose which lower-level function to call - depending on the required precision, and do the corresponding type - conversions. - These functions are also responsible for allocating temporary - storage, to simplify the use of accelerators. + High-level functions are at the top of the function call tree. + They are able to choose which lower-level function to call + depending on the required precision, and do the corresponding type + conversions. + These functions are also responsible for allocating temporary + storage, to simplify the use of accelerators. - The high-level functions should be pure, unless the introduction of - non-purity is justified. All the side effects should be made in the - =context= variable. + The high-level functions should be pure, unless the introduction of + non-purity is justified. All the side effects should be made in the + =context= variable. - # TODO : We need an identifier for impure functions + # TODO : We need an identifier for impure functions -*** Numerical precision +** Numerical precision - The number of bits of precision required for a function should be - given as an input of low-level computational functions. This input will - be used to define the values of the different thresholds that might - be used to avoid computing unnecessary noise. - High-level functions will use the precision specified in the - =context= variable. + The number of bits of precision required for a function should be + given as an input of low-level computational functions. This input will + be used to define the values of the different thresholds that might + be used to avoid computing unnecessary noise. + High-level functions will use the precision specified in the + =context= variable. -** Algorithms +* Algorithms - Reducing the scaling of an algorithm usually implies also reducing - its arithmetic complexity (number of flops per byte). Therefore, - for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms - are better adapted than linear scaling algorithms. - As QMCkl is a general purpose library, multiple algorithms should - be implemented adapted to different problem sizes. + Reducing the scaling of an algorithm usually implies also reducing + its arithmetic complexity (number of flops per byte). Therefore, + for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms + are better adapted than linear scaling algorithms. + As QMCkl is a general purpose library, multiple algorithms should + be implemented adapted to different problem sizes. -** Rules for the API +* Rules for the API - - =stdint= should be used for integers (=int32_t=, =int64_t=) - - integers used for counting should always be =int64_t= - - floats should be by default =double=, unless explicitly mentioned - - pointers are converted to =int64_t= to increase portability + - =stdint= should be used for integers (=int32_t=, =int64_t=) + - integers used for counting should always be =int64_t= + - floats should be by default =double=, unless explicitly mentioned + - pointers are converted to =int64_t= to increase portability -** Documentation +* Documentation -- [[qmckl.org][Main QMCkl header file]] -- [[qmckl_memory.org][Memory management]] -- [[qmckl_context.org][Context]] -- [[qmckl_distance.org][Distance]] + - [[./qmckl.org][Main QMCkl header file]] + - [[./qmckl_memory.org][Memory management]] + - [[./qmckl_context.org][Context]] + - [[./qmckl_distance.org][Distance]] -** Acknowledgments +* Acknowledgments -[[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] -[[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. + [[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] + [[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. diff --git a/src/create_doc.sh b/src/create_doc.sh new file mode 100755 index 0000000..eddf509 --- /dev/null +++ b/src/create_doc.sh @@ -0,0 +1,22 @@ +#!/bin/bash + +# Tangle org files + +emacsclient -a "" \ + --socket-name=org_to_code \ + --eval "(require 'org)" + +for INPUT in $@ ; do + echo $INPUT + emacsclient \ + --no-wait \ + --socket-name=org_to_code \ + --eval "(find-file \"$INPUT\")" \ + --eval "(org-html-export-to-html)" +done + +emacsclient \ + --no-wait \ + --socket-name=org_to_code \ + --eval '(kill-emacs)' + diff --git a/src/qmckl.org b/src/qmckl.org index f1065f5..2d7e4f7 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -2,6 +2,13 @@ # vim: syntax=c #+TITLE: QMCkl C header +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: + This file produces the =qmckl.h= header file, which is included in all other C header files. It is the main entry point to the library. diff --git a/src/qmckl_context.org b/src/qmckl_context.org index a2ea884..dd5b843 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -2,6 +2,14 @@ # vim: syntax=c #+TITLE: Context +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: + + This file is written in C because it is more natural to express the context in C than in Fortran. @@ -36,7 +44,7 @@ MunitResult test_qmckl_context() { outside of the library. To simplify compatibility with other languages, the pointer to the internal data structure is converted into a 64-bit signed integer, defined in the =qmckl_context= type. - A value of 0 for the context is equivalent to a NULL pointer. + A value of 0 for the context is equivalent to a =NULL= pointer. *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c @@ -347,7 +355,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran #+END_SRC - + ** =qmckl_context_get_precision= #+BEGIN_SRC C :comments link :tangle qmckl_context.h diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index d3d76e2..b5deee5 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -2,14 +2,21 @@ # vim: syntax=c #+TITLE: Computation of distances +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: + Function for the computation of distances between particles. 3 files are produced: -- a header file : =qmckl_distance.h= -- a source file : =qmckl_distance.f90= -- a test file : =test_qmckl_distance.c= +- a header file : =qmckl_distance.h= +- a source file : =qmckl_distance.f90= +- a test file : =test_qmckl_distance.c= -*** Header +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_distance.h #ifndef QMCKL_DISTANCE_H #define QMCKL_DISTANCE_H @@ -34,7 +41,7 @@ MunitResult test_qmckl_distance() { context = qmckl_context_create(); m = 5; - n = 6; + n = 6; LDA = 6; LDB = 10; LDC = 5; @@ -61,13 +68,13 @@ MunitResult test_qmckl_distance() { * Squared distance ** =qmckl_distance_sq= - + Computes the matrix of the squared distances between all pairs of points in two sets, one point within each set: \[ - C_{ij^2} = \sum_{k=1}^3 (A_{i,k}-B_{j,k})^2 + C_{ij} = \sum_{k=1}^3 (A_{i,k}-B_{j,k})^2 \] - + *** Arguments | =context= | input | Global state | @@ -95,7 +102,7 @@ MunitResult test_qmckl_distance() { *** Header #+BEGIN_SRC C :comments link :tangle qmckl_distance.h -qmckl_exit_code qmckl_distance_sq(qmckl_context context, +qmckl_exit_code qmckl_distance_sq(qmckl_context context, int64_t m, int64_t n, double *A, int64_t LDA, double *B, int64_t LDB, @@ -116,42 +123,42 @@ integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, real (c_double) , intent(in) :: B(LDB,3) integer (c_int64_t) , intent(in) , value :: LDC real (c_double) , intent(out) :: C(LDC,n) - + integer (c_int64_t) :: i,j real (c_double) :: x, y, z - + info = 0 - + if (context == 0_8) then info = -1 return endif - + if (m <= 0_8) then info = -2 return endif - + if (n <= 0_8) then info = -3 return endif - + if (LDA < m) then info = -4 return endif - + if (LDB < n) then info = -5 return endif - + if (LDC < m) then info = -6 return endif - + do j=1,n do i=1,m x = A(i,1) - B(j,1) @@ -160,25 +167,25 @@ integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, C(i,j) = x*x + y*y + z*z end do end do - + end function qmckl_distance_sq #+END_SRC *** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c - munit_assert_int64(QMCKL_SUCCESS, ==, + munit_assert_int64(QMCKL_SUCCESS, ==, qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) ); for (j=0 ; j +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: + + We override the allocation functions to enable the possibility of optimized libraries to fine-tune the memory allocation. 3 files are produced: -- a header file : =qmckl_memory.h= -- a source file : =qmckl_memory.c= -- a test file : =test_qmckl_memory.c= +- a header file : =qmckl_memory.h= +- a source file : =qmckl_memory.c= +- a test file : =test_qmckl_memory.c= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h +** Header + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h #ifndef QMCKL_MEMORY_H #define QMCKL_MEMORY_H #include "qmckl.h" - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_memory.c +** Source + #+BEGIN_SRC C :comments link :tangle qmckl_memory.c #include #include "qmckl_memory.h" - #+END_SRC + #+END_SRC -*** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c +** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_memory() { - #+END_SRC + #+END_SRC -** =qmckl_malloc= - Analogous of =malloc, but passing a context and a signed 64-bit integers as argument.= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h +* =qmckl_malloc= + Analogous of =malloc, but passing a context and a signed 64-bit integers as argument.= +** Header + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h void* qmckl_malloc(const qmckl_context ctx, const size_t size); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_memory.c +** Source + #+BEGIN_SRC C :comments link :tangle qmckl_memory.c void* qmckl_malloc(const qmckl_context ctx, const size_t size) { if (ctx == (qmckl_context) 0) { /* Avoids unused parameter error */ @@ -47,10 +55,10 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size) { return malloc( (size_t) size ); } - #+END_SRC - -*** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c + #+END_SRC + +** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c int *a; a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); a[0] = 1; @@ -59,37 +67,37 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size) { munit_assert_int(a[0], ==, 1); munit_assert_int(a[1], ==, 2); munit_assert_int(a[2], ==, 3); - #+END_SRC + #+END_SRC -** =qmckl_free= +* =qmckl_free= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h +** Header + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h void qmckl_free(void *ptr); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_memory.c +** Source + #+BEGIN_SRC C :comments link :tangle qmckl_memory.c void qmckl_free(void *ptr) { free(ptr); } - #+END_SRC - -*** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c + #+END_SRC + +** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c qmckl_free(a); - #+END_SRC + #+END_SRC * End of files -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h +** Header + #+BEGIN_SRC C :comments link :tangle qmckl_memory.h #endif - #+END_SRC + #+END_SRC -*** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c +** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c return MUNIT_OK; -} +} - #+END_SRC + #+END_SRC diff --git a/src/test_qmckl.org b/src/test_qmckl.org index 2171739..f2ca850 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -1,5 +1,12 @@ #+TITLE: QMCkl test +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: + This file is the main program of the unit tests. The tests rely on the $\mu$unit framework, which is provided as a git submodule. From 5e9e74f743a9eacaa6f4cfaa721f0c4f2e1d9a3b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 25 Oct 2020 15:02:37 +0100 Subject: [PATCH 21/61] Added polynomials --- src/Makefile | 4 +- src/README.org | 12 +- src/qmckl.org | 1 + src/qmckl_ao.org | 400 +++++++++++++++++++++++++++++++++++++++++ src/qmckl_distance.org | 73 +++++--- src/test_qmckl.org | 3 + 6 files changed, 457 insertions(+), 36 deletions(-) create mode 100644 src/qmckl_ao.org diff --git a/src/Makefile b/src/Makefile index d5b363d..d98f8e6 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,7 +2,7 @@ CC=gcc CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g FC=gfortran -FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan +FFLAGS=-fPIC -g -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan LIBS=-lgfortran -lm @@ -25,7 +25,7 @@ doc:$(ORG_SOURCE_FILES) ./create_doc.sh $(ORG_SOURCE_FILES) clean: - rm -f qmckl.h test_qmckl_* qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so + rm -f qmckl.h test_qmckl_* test_qmckl.c qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh ./create_makefile.sh $(ORG_SOURCE_FILES) diff --git a/src/README.org b/src/README.org index 5b2ade4..698ea34 100644 --- a/src/README.org +++ b/src/README.org @@ -103,6 +103,8 @@ rm ${nb}.md If the name of the org-mode file is =xxx.org=, the name of the produced C files should be =xxx.c= and =xxx.h= and the name of the produced Fortran files should be =xxx.f90= + + Arrays are in uppercase and scalars are in lowercase. ** Application programming interface @@ -111,17 +113,17 @@ rm ${nb}.md that the library will be easily usable in any language. This implies that only the following data types are allowed in the API: - - 32-bit and 64-bit floats and arrays - - 32-bit and 64-bit integers and arrays + - 32-bit and 64-bit floats and arrays (=real= and =double=) + - 32-bit and 64-bit integers and arrays (=int32_t= and =int64_t=) - Pointers should be represented as 64-bit integers (even on 32-bit architectures) - ASCII strings are represented as a pointers to a character arrays and terminated by a zero character (C convention). + # TODO : Link to repositories for bindings To facilitate the use in other languages than C, we provide some bindings in other languages in other repositories. - # TODO : Link to repositories for bindings ** Global state @@ -178,7 +180,7 @@ rm ${nb}.md =context= variable. * Algorithms - + Reducing the scaling of an algorithm usually implies also reducing its arithmetic complexity (number of flops per byte). Therefore, for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms @@ -186,7 +188,6 @@ rm ${nb}.md As QMCkl is a general purpose library, multiple algorithms should be implemented adapted to different problem sizes. - * Rules for the API - =stdint= should be used for integers (=int32_t=, =int64_t=) @@ -200,6 +201,7 @@ rm ${nb}.md - [[./qmckl_memory.org][Memory management]] - [[./qmckl_context.org][Context]] - [[./qmckl_distance.org][Distance]] + - [[./qmckl_ao.org][Atomic orbitals]] * Acknowledgments diff --git a/src/qmckl.org b/src/qmckl.org index 2d7e4f7..c48e771 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -58,6 +58,7 @@ typedef int64_t qmckl_context ; #include "qmckl_context.h" #include "qmckl_distance.h" +#include "qmckl_ao.h" #+END_SRC * End of header diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org new file mode 100644 index 0000000..ba01f8d --- /dev/null +++ b/src/qmckl_ao.org @@ -0,0 +1,400 @@ +# -*- mode: org -*- +# vim: syntax=c +#+TITLE: Atomic Orbitals + +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: +#+HTML_HEAD: + +This files contains all the routines for the computation of the +values, gradients and Laplacian of the atomic basis functions. + +3 files are produced: +- a header file : =qmckl_ao.h= +- a source file : =qmckl_ao.f90= +- a test file : =test_qmckl_ao.c= + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +#ifndef QMCKL_AO_H +#define QMCKL_AO_H +#include "qmckl_context.h" +#include "qmckl_distance.h" + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 + + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c +#include +#include "qmckl.h" +#include "munit.h" +MunitResult test_qmckl_ao() { + qmckl_context context; + context = qmckl_context_create(); + #+END_SRC + + +* Polynomials + + \[ P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c \] + +** =qmckl_ao_powers= + + Computes all the powers of the =n= input data up to the given + maximum value given in input for each of the $n$ points: + + \[ P_{ij} = X_j^i \] + +*** Arguments + + | =context= | input | Global state | + | =n= | input | Number of values | + | =X(n)= | input | Array containing the input values | + | =LMAX(n)= | input | Array containing the maximum power for each value | + | =P(LDP,n)= | output | Array containing all the powers of $X$ | + | =LDP= | input | Leading dimension of array =P= | + +*** Requirements + + - =context= is not 0 + - =n= > 0 + - =X= is allocated with at least $n \times 8$ bytes + - =LMAX= is allocated with at least $n \times 4$ bytes + - =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - =LDP= >= $\max_i$ =LMAX[i]= + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +qmckl_exit_code qmckl_ao_powers(qmckl_context context, + int64_t n, + double *X, int32_t *LMAX, + double *P, int64_t LDP); + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) + implicit none + integer*8 , intent(in) :: context + integer*8 , intent(in) :: n + real*8 , intent(in) :: X(n) + integer , intent(in) :: LMAX(n) + real*8 , intent(out) :: P(ldp,n) + integer*8 , intent(in) :: ldp + + integer*8 :: i,j + + info = 0 + + if (context == 0_8) then + info = -1 + return + endif + + if (LDP < MAXVAL(LMAX)) then + info = -2 + return + endif + + do j=1,n + P(1,j) = X(j) + do i=2,LMAX(j) + P(i,j) = P(i-1,j) * X(j) + end do + end do + +end function qmckl_ao_powers_f + + +integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: n + real (c_double) , intent(in) :: X(n) + integer (c_int32_t) , intent(in) :: LMAX(n) + real (c_double) , intent(out) :: P(ldp,n) + integer (c_int64_t) , intent(in) , value :: ldp + + integer, external :: qmckl_ao_powers_f + info = qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) +end function qmckl_ao_powers + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c +{ + int64_t n, LDP ; + int32_t *LMAX ; + double *X, *P ; + int i, j; + + n = 100; + LDP = 10; + + X = (double*) qmckl_malloc (context, n*sizeof(double)); + LMAX = (int32_t*) qmckl_malloc (context, n*sizeof(int32_t)); + P = (double*) qmckl_malloc (context, LDP*n*sizeof(double)); + + for (j=0 ; j 0 + - =X= is allocated with at least $3 \times 8$ bytes + - =R= is allocated with at least $3 \times 8$ bytes + - =lmax= >= 0 + - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 + - =L= is allocated with at least $3 \times n \times 4$ bytes + - =ldl= >= 3 + - =VGL= is allocated with at least $5 \times n \times 8$ bytes + - =ldv= >= 5 + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +qmckl_exit_code qmckl_ao_polynomial_vgl(qmckl_context context, + double *X, double *R, + int32_t lmax, int64_t *n, + int32_t *L, int64_t ldl, + double *VGL, int64_t ldv); + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) + implicit none + integer*8 , intent(in) :: context + real*8 , intent(in) :: X(3), R(3) + integer , intent(in) :: lmax + integer*8 , intent(out) :: n + integer , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer*8 , intent(in) :: ldl + real*8 , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer*8 , intent(in) :: ldv + + integer*8 :: i,j + integer :: a,b,c,d + real*8 :: Y(3) + integer :: lmax_array(3) + real*8 :: pows(-2:lmax,3) + integer, external :: qmckl_ao_powers_f + + info = 0 + + if (context == 0_8) then + info = -1 + return + endif + + n = (lmax+1)*(lmax+2)*(lmax+3)/6 + + if (ldl < 3) then + info = -2 + return + endif + + if (ldv < 5) then + info = -3 + return + endif + + + do i=1,3 + Y(i) = X(i) - R(i) + end do + pows(-2:-1,1:3) = 0.d0 + pows(0,1:3) = 1.d0 + lmax_array(1:3) = lmax + info = qmckl_ao_powers_f(context, 1_8, Y(1), (/lmax/), pows(1,1), size(pows,1,kind=8)) + if (info /= 0) return + info = qmckl_ao_powers_f(context, 1_8, Y(2), (/lmax/), pows(1,2), size(pows,1,kind=8)) + if (info /= 0) return + info = qmckl_ao_powers_f(context, 1_8, Y(3), (/lmax/), pows(1,3), size(pows,1,kind=8)) + if (info /= 0) return + + + n=1 + vgl(1:5,1:n) = 0.d0 + l(1:3,n) = 0 + vgl(1,n) = 1.d0 + do d=1,lmax + do a=0,d + do b=0,d + do c=0,d + if (a+b+c == d) then + n = n+1 + l(1,n) = a + l(2,n) = b + l(3,n) = c + + vgl(1,n) = pows(a,1) * pows(b,2) * pows(c,3) + + vgl(2,n) = dble(a) * pows(a-1,1) * pows(b ,2) * pows(c ,3) + vgl(3,n) = dble(b) * pows(a ,1) * pows(b-1,2) * pows(c ,3) + vgl(4,n) = dble(c) * pows(a ,1) * pows(b ,2) * pows(c-1,3) + + vgl(5,n) = dble(a) * dble(a-1) * pows(a-2,1) * pows(b ,2) * pows(c ,3) & + + dble(b) * dble(b-1) * pows(a ,1) * pows(b-2,2) * pows(c ,3) & + + dble(c) * dble(c-1) * pows(a ,1) * pows(b ,2) * pows(c-2,3) + exit + end if + end do + end do + end do + end do + +end function qmckl_ao_polynomial_vgl_f + +integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + real (c_double) , intent(in) :: X(3), R(3) + integer (c_int32_t) , intent(in) , value :: lmax + integer (c_int64_t) , intent(out) :: n + integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer (c_int64_t) , intent(in) , value :: ldl + real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + integer (c_int64_t) , intent(in) , value :: ldv + + integer, external :: qmckl_ao_polynomial_vgl_f + info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) +end function qmckl_ao_polynomial_vgl + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c +{ +#include + double X[3] = { 1.1 , 2.2 , 3.3 }; + double R[3] = { 0.1 , 1.2 , -2.3 }; + double Y[3]; + int32_t lmax = 4; + int64_t n = 0; + int64_t ldl = 3; + int64_t ldv = 100; + int32_t* L_mem; + int32_t* L[100]; + double* VGL_mem; + double* VGL[100]; + int j; + + int d = (lmax+1)*(lmax+2)*(lmax+3)/6; + + L_mem = (int32_t*) malloc(ldl*100*sizeof(int32_t)); + VGL_mem = (double*) malloc(ldv*100*sizeof(double)); + + munit_assert_int64(QMCKL_SUCCESS, ==, + qmckl_ao_polynomial_vgl(context, X, R, lmax, &n, L_mem, ldl, VGL_mem, ldv) ); + + munit_assert_int64( n, ==, d ); + for (j=0 ; j=, 0 ); + munit_assert_int64( L[j][1], >=, 0 ); + munit_assert_int64( L[j][2], >=, 0 ); + munit_assert_double_equal( VGL[j][0], + pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]), 10 ); + if (L[j][0] < 1) { + munit_assert_double_equal( VGL[j][1], 0., 10); + } else { + munit_assert_double_equal( VGL[j][1], + L[j][0] * pow(Y[0],L[j][0]-1) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]), 10 ); + } + if (L[j][1] < 1) { + munit_assert_double_equal( VGL[j][2], 0., 10); + } else { + munit_assert_double_equal( VGL[j][2], + L[j][1] * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]-1) * pow(Y[2],L[j][2]), 10 ); + } + if (L[j][2] < 1) { + munit_assert_double_equal( VGL[j][3], 0., 10); + } else { + munit_assert_double_equal( VGL[j][3], + L[j][2] * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]-1), 10 ); + } + + double w = 0.; + if (L[j][0] > 1) w += L[j][0] * (L[j][0]-1) * pow(Y[0],L[j][0]-2) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]); + if (L[j][1] > 1) w += L[j][1] * (L[j][1]-1) * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]-2) * pow(Y[2],L[j][2]); + if (L[j][2] > 1) w += L[j][2] * (L[j][2]-1) * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]-2); + munit_assert_double_equal( VGL[j][4], w, 10 ); + } + free(L_mem); + free(VGL_mem); +} + #+END_SRC + + + +* TODO Gaussian basis functions + +* TODO Slater basis functions + +* End of files + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +#endif + #+END_SRC + +*** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c + if (qmckl_context_destroy(context) != QMCKL_SUCCESS) + return QMCKL_FAILURE; + return MUNIT_OK; +} + + #+END_SRC diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index b5deee5..cba53ca 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -77,25 +77,24 @@ MunitResult test_qmckl_distance() { *** Arguments - | =context= | input | Global state | - | =m= | input | Number of points in the first set | - | =n= | input | Number of points in the second set | - | =LDA= | input | Leading dimension of array =A= | - | =A= | input | Array containing the $3 \times m$ matrix $A$ | - | =LDB= | input | Leading dimension of array =B= | - | =B= | input | Array containing the $3 \times n$ matrix $B$ | - | =LDC= | input | Leading dimension of array =C= | - | =C= | output | Array containing the $m \times n$ matrix $C$ | - | =info= | output | exit status is zero upon success | + | =context= | input | Global state | + | =m= | input | Number of points in the first set | + | =n= | input | Number of points in the second set | + | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | + | =lda= | input | Leading dimension of array =A= | + | =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ | + | =ldb= | input | Leading dimension of array =B= | + | =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ | + | =ldc= | input | Leading dimension of array =C= | *** Requirements - =context= is not 0 - =m= > 0 - =n= > 0 - - =LDA= >= m - - =LDB= >= n - - =LDC= >= m + - =lda= >= m + - =ldb= >= n + - =ldc= >= m - =A= is allocated with at least $3 \times m \times 8$ bytes - =B= is allocated with at least $3 \times n \times 8$ bytes - =C= is allocated with at least $m \times n \times 8$ bytes @@ -104,28 +103,26 @@ MunitResult test_qmckl_distance() { #+BEGIN_SRC C :comments link :tangle qmckl_distance.h qmckl_exit_code qmckl_distance_sq(qmckl_context context, int64_t m, int64_t n, - double *A, int64_t LDA, - double *B, int64_t LDB, - double *C, int64_t LDC); + double *A, int64_t lda, + double *B, int64_t ldb, + double *C, int64_t ldc); #+END_SRC *** Source #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 -integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) & - bind(C) result(info) - use, intrinsic :: iso_c_binding +integer function qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) result(info) implicit none - integer (c_int64_t) , intent(in) , value :: context - integer (c_int64_t) , intent(in) , value :: m, n - integer (c_int64_t) , intent(in) , value :: LDA - real (c_double) , intent(in) :: A(LDA,3) - integer (c_int64_t) , intent(in) , value :: LDB - real (c_double) , intent(in) :: B(LDB,3) - integer (c_int64_t) , intent(in) , value :: LDC - real (c_double) , intent(out) :: C(LDC,n) + integer*8 , intent(in) :: context + integer*8 , intent(in) :: m, n + integer*8 , intent(in) :: lda + real*8 , intent(in) :: A(lda,3) + integer*8 , intent(in) :: ldb + real*8 , intent(in) :: B(ldb,3) + integer*8 , intent(in) :: ldc + real*8 , intent(out) :: C(ldc,n) - integer (c_int64_t) :: i,j - real (c_double) :: x, y, z + integer*8 :: i,j + real*8 :: x, y, z info = 0 @@ -168,6 +165,24 @@ integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, end do end do +end function qmckl_distance_sq_f + +! C interface +integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: m, n + integer (c_int64_t) , intent(in) , value :: lda + real (c_double) , intent(in) :: A(lda,3) + integer (c_int64_t) , intent(in) , value :: ldb + real (c_double) , intent(in) :: B(ldb,3) + integer (c_int64_t) , intent(in) , value :: ldc + real (c_double) , intent(out) :: C(ldc,n) + + integer, external :: qmckl_distance_sq_f + info = qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) end function qmckl_distance_sq #+END_SRC diff --git a/src/test_qmckl.org b/src/test_qmckl.org index f2ca850..bcd0fce 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -23,6 +23,7 @@ grep BEGIN_SRC *.org | \ #+END_SRC #+RESULTS: test-files +| test_qmckl_ao.c | | test_qmckl_context.c | | test_qmckl_distance.c | | test_qmckl_memory.c | @@ -42,6 +43,7 @@ echo "#+END_SRC" #+RESULTS: #+NAME: headers #+BEGIN_SRC C :tangle no +MunitResult test_qmckl_ao(); MunitResult test_qmckl_context(); MunitResult test_qmckl_distance(); MunitResult test_qmckl_memory(); @@ -62,6 +64,7 @@ echo "#+END_SRC" #+RESULTS: #+NAME: calls #+BEGIN_SRC C :tangle no + { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, From 959d4d1110e6edfb6ff4496c8c781bd5eed89987 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 25 Oct 2020 15:16:02 +0100 Subject: [PATCH 22/61] Added noexport --- src/qmckl_ao.org | 28 ++++++++++++++-------------- src/qmckl_context.org | 37 +++++++++++++++++++++---------------- src/qmckl_distance.org | 12 ++++++------ src/qmckl_memory.org | 12 ++++++------ 4 files changed, 47 insertions(+), 42 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index ba01f8d..f080e77 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -17,7 +17,7 @@ values, gradients and Laplacian of the atomic basis functions. - a source file : =qmckl_ao.f90= - a test file : =test_qmckl_ao.c= -*** Header +*** Header :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_ao.h #ifndef QMCKL_AO_H #define QMCKL_AO_H @@ -25,12 +25,12 @@ values, gradients and Laplacian of the atomic basis functions. #include "qmckl_distance.h" #+END_SRC -*** Source +*** Source :noexport: #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c #include #include "qmckl.h" @@ -58,7 +58,7 @@ MunitResult test_qmckl_ao() { | =n= | input | Number of values | | =X(n)= | input | Array containing the input values | | =LMAX(n)= | input | Array containing the maximum power for each value | - | =P(LDP,n)= | output | Array containing all the powers of $X$ | + | =P(LDP,n)= | output | Array containing all the powers of =X= | | =LDP= | input | Leading dimension of array =P= | *** Requirements @@ -129,7 +129,7 @@ integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & end function qmckl_ao_powers #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c { int64_t n, LDP ; @@ -166,8 +166,7 @@ end function qmckl_ao_powers ** =qmckl_ao_polynomial_vgl= - Computes the value, gradient and Laplacian of the Polynomials for each - point given in input and for each center + Computes the value, gradient and Laplacian of a Polynomial. *** Arguments @@ -176,10 +175,10 @@ end function qmckl_ao_powers | =R(3)= | input | Array containing the x,y,z coordinates of the center | | =lmax= | input | Maximum angular momentum | | =n= | output | Number of computed polynomials | - | =L(LDL,n)= | output | Contains a,b,c for all =n= results | - | =LDL= | input | Leading dimension of =L= | - | =VGL(LDV,n)= | output | Value, gradients and Laplacian of the polynomials | - | =LDV= | input | Leading dimension of array =VGL= | + | =L(ldl,n)= | output | Contains a,b,c for all =n= results | + | =ldl= | input | Leading dimension of =L= | + | =VGL(ldv,n)= | output | Value, gradients and Laplacian of the polynomials | + | =ldv= | input | Leading dimension of array =VGL= | *** Requirements @@ -289,6 +288,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, end function qmckl_ao_polynomial_vgl_f +! C interface integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -307,7 +307,7 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l end function qmckl_ao_polynomial_vgl #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c { #include @@ -383,8 +383,8 @@ end function qmckl_ao_polynomial_vgl * TODO Slater basis functions -* End of files - +* End of files :noexport: + *** Header #+BEGIN_SRC C :comments link :tangle qmckl_ao.h #endif diff --git a/src/qmckl_context.org b/src/qmckl_context.org index dd5b843..00ca914 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -18,19 +18,19 @@ C than in Fortran. - a source file : =qmckl_context.c= - a test file : =test_qmckl_context.c= -*** Header +*** Header :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_context.h #ifndef QMCKL_CONTEXT_H #define QMCKL_CONTEXT_H #include "qmckl.h" #+END_SRC -*** Source +*** Source :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_context.c #include "qmckl.h" #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c #include "qmckl.h" #include "munit.h" @@ -62,7 +62,7 @@ typedef struct qmckl_context_struct { The tag is used internally to check if the memory domain pointed by a pointer is a valid context. -*** Test +*** Test :noexport: We declare here the variables used in the tests. #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c qmckl_context context; @@ -125,7 +125,7 @@ qmckl_context qmckl_context_create() { } #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c context = qmckl_context_create(); munit_assert_int64( context, !=, (qmckl_context) 0); @@ -176,7 +176,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); munit_assert_int64(new_context, !=, (qmckl_context) 0); @@ -213,7 +213,7 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { } #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous(new_context), ==, context); @@ -253,7 +253,7 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { } #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(new_context, !=, (qmckl_context) 0); @@ -275,7 +275,7 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. ** =qmckl_context_update_precision= - +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC @@ -295,7 +295,9 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons } #+END_SRC +*** TODO Tests :noexport: ** =qmckl_context_update_range= +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); #+END_SRC @@ -315,10 +317,9 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in } #+END_SRC - - +*** TODO Tests :noexport: ** =qmckl_context_set_precision= - +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC @@ -336,7 +337,9 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int } #+END_SRC +*** TODO Tests :noexport: ** =qmckl_context_set_range= +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC @@ -354,10 +357,10 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran } #+END_SRC - +*** TODO Tests :noexport: ** =qmckl_context_get_precision= - +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.h int qmckl_context_get_precision(const qmckl_context context); #+END_SRC @@ -370,7 +373,9 @@ int qmckl_context_get_precision(const qmckl_context context) { } #+END_SRC +*** TODO Tests :noexport: ** =qmckl_context_get_range= +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.h int qmckl_context_get_range(const qmckl_context context); @@ -384,9 +389,9 @@ int qmckl_context_get_range(const qmckl_context context) { } #+END_SRC +*** TODO Tests :noexport: - -* End of files +* End of files :noexport: *** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index cba53ca..1ea2856 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -16,18 +16,18 @@ Function for the computation of distances between particles. - a source file : =qmckl_distance.f90= - a test file : =test_qmckl_distance.c= -*** Header +*** Header :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_distance.h #ifndef QMCKL_DISTANCE_H #define QMCKL_DISTANCE_H #include "qmckl_context.h" #+END_SRC -*** Source +*** Source :noexport: #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c #include #include "qmckl.h" @@ -186,7 +186,7 @@ integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, end function qmckl_distance_sq #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c munit_assert_int64(QMCKL_SUCCESS, ==, @@ -205,12 +205,12 @@ end function qmckl_distance_sq #+END_SRC * End of files -*** Header +*** Header :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_distance.h #endif #+END_SRC -*** Test +*** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c qmckl_free(A); qmckl_free(B); diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index e8b5148..b6326b2 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -18,20 +18,20 @@ optimized libraries to fine-tune the memory allocation. - a source file : =qmckl_memory.c= - a test file : =test_qmckl_memory.c= -** Header +** Header :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_memory.h #ifndef QMCKL_MEMORY_H #define QMCKL_MEMORY_H #include "qmckl.h" #+END_SRC -** Source +** Source :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_memory.c #include #include "qmckl_memory.h" #+END_SRC -** Test +** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c #include "qmckl.h" #include "munit.h" @@ -57,7 +57,7 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size) { #+END_SRC -** Test +** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c int *a; a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); @@ -83,12 +83,12 @@ void qmckl_free(void *ptr) { } #+END_SRC -** Test +** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c qmckl_free(a); #+END_SRC -* End of files +* End of files :noexport: ** Header #+BEGIN_SRC C :comments link :tangle qmckl_memory.h From 8df6823f508333d99952c26ddbfaf9b2092e687f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sun, 25 Oct 2020 15:25:15 +0100 Subject: [PATCH 23/61] Removed C interface from export --- src/qmckl_ao.org | 11 ++++++++--- src/qmckl_distance.org | 4 +++- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index f080e77..96d1677 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -111,8 +111,10 @@ integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) end do end function qmckl_ao_powers_f + #+END_SRC - +*** C interface :noexport: + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -166,7 +168,8 @@ end function qmckl_ao_powers ** =qmckl_ao_polynomial_vgl= - Computes the value, gradient and Laplacian of a Polynomial. + Computes the values, gradients and Laplacians at a given point of + all polynomials with an angular momentum up to =lmax=. *** Arguments @@ -287,8 +290,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, end do end function qmckl_ao_polynomial_vgl_f + #+END_SRC -! C interface +*** C interface :noexport: + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 1ea2856..40ee574 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -166,8 +166,10 @@ integer function qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) resu end do end function qmckl_distance_sq_f + #+END_SRC -! C interface +*** C interface :noexport: + #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) & bind(C) result(info) use, intrinsic :: iso_c_binding From f0c92263935f7bfc5da39614da3316da5c28a8c9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 Oct 2020 16:51:16 +0100 Subject: [PATCH 24/61] Allow tests in fortran --- src/create_makefile.sh | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/src/create_makefile.sh b/src/create_makefile.sh index 959fdc8..3ff14b9 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -37,10 +37,16 @@ done >> $OUTPUT TESTS="" for i in $(ls test_qmckl_*.c) ; do - FILE=${i} + FILE=${i%.c}.o TESTS="${TESTS} ${FILE}" done >> $OUTPUT +TESTS_F="" +for i in $(ls test_qmckl_*.f90) ; do + FILE=${i%.f90}.o + TESTS_F="${TESTS_F} ${FILE}" +done >> $OUTPUT + # Write the Makefile @@ -52,6 +58,7 @@ FC=$FC FFLAGS=$FFLAGS OBJECT_FILES=$OBJECTS TESTS=$TESTS +TESTS_F=$TESTS_F LIBS=$LIBS @@ -64,10 +71,9 @@ libqmckl.so: \$(OBJECT_FILES) %.o: %.f90 \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o -test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) - echo \$(TESTS) +test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) \$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \ - ../munit/munit.c \$(TESTS) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl + ../munit/munit.c \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl test: test_qmckl ./test_qmckl @@ -91,3 +97,9 @@ for i in $(ls test_qmckl_*.c) ; do done >> $OUTPUT +for i in $(ls test_qmckl*.f90) ; do + FILE=${i%.f90} + echo "${FILE}.o: ${FILE}.f90" +done >> $OUTPUT + + From 4c7b2213f49759c2b6f8fb8c0b0cd4bdf2c4c02e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 Oct 2020 18:24:23 +0100 Subject: [PATCH 25/61] Distance test in Fortran --- src/qmckl_distance.org | 96 +++++++++++++++++++++++------------------- 1 file changed, 52 insertions(+), 44 deletions(-) diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 40ee574..d69b133 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -34,34 +34,8 @@ Function for the computation of distances between particles. #include "munit.h" MunitResult test_qmckl_distance() { qmckl_context context; - int64_t m, n, LDA, LDB, LDC; - double *A, *B, *C ; - int i, j; - context = qmckl_context_create(); - m = 5; - n = 6; - LDA = 6; - LDB = 10; - LDC = 5; - - A = (double*) qmckl_malloc (context, LDA*4*sizeof(double)); - B = (double*) qmckl_malloc (context, LDB*3*sizeof(double)); - C = (double*) qmckl_malloc (context, LDC*n*sizeof(double)); - - for (j=0 ; j<3 ; j++) { - for (i=0 ; i 1.d-12 ) return + end do + end do + test_qmckl_distance_sq = 0 + + deallocate(A,B,C) + end function test_qmckl_distance_sq + #+END_SRC + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c - - munit_assert_int64(QMCKL_SUCCESS, ==, - qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) ); - - for (j=0 ; j Date: Mon, 26 Oct 2020 19:30:50 +0100 Subject: [PATCH 26/61] Tests in Fortran --- src/Makefile | 10 +- src/README.org | 9 +- src/qmckl_ao.org | 251 +++++++++++++++++++++++++---------------- src/qmckl_distance.org | 120 +++++++++++--------- 4 files changed, 237 insertions(+), 153 deletions(-) diff --git a/src/Makefile b/src/Makefile index d98f8e6..c4e7fc1 100644 --- a/src/Makefile +++ b/src/Makefile @@ -6,6 +6,14 @@ FFLAGS=-fPIC -g -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wi LIBS=-lgfortran -lm +#CC=icc +#CFLAGS=-fPIC -g +# +#FC=ifort +#FFLAGS=-fPIC -g +# +#LIBS=-lm -lifcore -lirc + export CC CFLAGS FC FFLAGS LIBS @@ -25,7 +33,7 @@ doc:$(ORG_SOURCE_FILES) ./create_doc.sh $(ORG_SOURCE_FILES) clean: - rm -f qmckl.h test_qmckl_* test_qmckl.c qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html + rm -f qmckl.h test_qmckl_* test_qmckl.c qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh ./create_makefile.sh $(ORG_SOURCE_FILES) diff --git a/src/README.org b/src/README.org index 698ea34..01aa7ae 100644 --- a/src/README.org +++ b/src/README.org @@ -72,9 +72,13 @@ rm ${nb}.md ** Writing in Fortran The Fortran source files should provide a C interface using - iso-c-binding. The name of the Fortran source files should end + =iso_c_binding=. The name of the Fortran source files should end with =_f.f90= to be properly handled by the Makefile. - + The names of the functions defined in fortran should be the same as + those exposed in the API suffixed by =_f=. + Fortran interface files should also be written in a file with a + =.fh= extension. + ** Coding style # TODO: decide on a coding style @@ -124,7 +128,6 @@ rm ${nb}.md To facilitate the use in other languages than C, we provide some bindings in other languages in other repositories. - ** Global state Global variables should be avoided in the library, because it is diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 96d1677..5511e74 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -12,10 +12,11 @@ This files contains all the routines for the computation of the values, gradients and Laplacian of the atomic basis functions. -3 files are produced: +4 files are produced: - a header file : =qmckl_ao.h= - a source file : =qmckl_ao.f90= -- a test file : =test_qmckl_ao.c= +- a C test file : =test_qmckl_ao.c= +- a Fortran test file : =test_qmckl_ao_f.f90= *** Header :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_ao.h @@ -25,11 +26,6 @@ values, gradients and Laplacian of the atomic basis functions. #include "qmckl_distance.h" #+END_SRC -*** Source :noexport: - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 - - #+END_SRC - *** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c #include @@ -131,40 +127,64 @@ integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & end function qmckl_ao_powers #+END_SRC + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh + interface + integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: n + integer (c_int64_t) , intent(in) , value :: ldp + real (c_double) , intent(in) :: X(n) + integer (c_int32_t) , intent(in) :: LMAX(n) + real (c_double) , intent(out) :: P(ldp,n) + end function qmckl_ao_powers + end interface + #+END_SRC + *** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c -{ - int64_t n, LDP ; - int32_t *LMAX ; - double *X, *P ; - int i, j; + #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 +integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) + use, intrinsic :: iso_c_binding + implicit none + include 'qmckl_ao.fh' + integer(c_int64_t), intent(in), value :: context + + integer*8 :: n, LDP + integer, allocatable :: LMAX(:) + double precision, allocatable :: X(:), P(:,:) + integer*8 :: i,j + n = 100; LDP = 10; + + allocate(X(n), P(LDP,n), LMAX(n)) + + do j=1,n + X(j) = -5.d0 + 0.1d0 * dble(j) + LMAX(j) = 1 + int(mod(j, 9),4) + end do + + test_qmckl_ao_powers = qmckl_ao_powers(context, n, X, LMAX, P, LDP) + if (test_qmckl_ao_powers /= 0) return + + test_qmckl_ao_powers = -1 + + do j=1,n + do i=1,LMAX(j) + if ( dabs(1.d0 - P(i,j) / (X(j)**i)) > 1.d-14 ) return + end do + end do - X = (double*) qmckl_malloc (context, n*sizeof(double)); - LMAX = (int32_t*) qmckl_malloc (context, n*sizeof(int32_t)); - P = (double*) qmckl_malloc (context, LDP*n*sizeof(double)); + test_qmckl_ao_powers = 0 + deallocate(X,P,LMAX) +end function test_qmckl_ao_powers + #+END_SRC - for (j=0 ; j - double X[3] = { 1.1 , 2.2 , 3.3 }; - double R[3] = { 0.1 , 1.2 , -2.3 }; - double Y[3]; - int32_t lmax = 4; - int64_t n = 0; - int64_t ldl = 3; - int64_t ldv = 100; - int32_t* L_mem; - int32_t* L[100]; - double* VGL_mem; - double* VGL[100]; - int j; + #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 +integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) + use, intrinsic :: iso_c_binding + implicit none + include 'qmckl_ao.fh' - int d = (lmax+1)*(lmax+2)*(lmax+3)/6; + integer(c_int64_t), intent(in), value :: context + + integer :: lmax, d, i + integer, allocatable :: L(:,:) + integer*8 :: n, ldl, ldv, j + double precision :: X(3), R(3), Y(3) + double precision, allocatable :: VGL(:,:) + double precision :: w - L_mem = (int32_t*) malloc(ldl*100*sizeof(int32_t)); - VGL_mem = (double*) malloc(ldv*100*sizeof(double)); + X = (/ 1.1 , 2.2 , 3.3 /) + R = (/ 0.1 , 1.2 , -2.3 /) + Y(:) = X(:) - R(:) - munit_assert_int64(QMCKL_SUCCESS, ==, - qmckl_ao_polynomial_vgl(context, X, R, lmax, &n, L_mem, ldl, VGL_mem, ldv) ); + lmax = 4; + n = 0; + ldl = 3; + ldv = 100; - munit_assert_int64( n, ==, d ); - for (j=0 ; j=, 0 ); - munit_assert_int64( L[j][1], >=, 0 ); - munit_assert_int64( L[j][2], >=, 0 ); - munit_assert_double_equal( VGL[j][0], - pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]), 10 ); - if (L[j][0] < 1) { - munit_assert_double_equal( VGL[j][1], 0., 10); - } else { - munit_assert_double_equal( VGL[j][1], - L[j][0] * pow(Y[0],L[j][0]-1) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]), 10 ); - } - if (L[j][1] < 1) { - munit_assert_double_equal( VGL[j][2], 0., 10); - } else { - munit_assert_double_equal( VGL[j][2], - L[j][1] * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]-1) * pow(Y[2],L[j][2]), 10 ); - } - if (L[j][2] < 1) { - munit_assert_double_equal( VGL[j][3], 0., 10); - } else { - munit_assert_double_equal( VGL[j][3], - L[j][2] * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]-1), 10 ); - } + allocate (L(ldl,100), VGL(ldv,100)) - double w = 0.; - if (L[j][0] > 1) w += L[j][0] * (L[j][0]-1) * pow(Y[0],L[j][0]-2) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]); - if (L[j][1] > 1) w += L[j][1] * (L[j][1]-1) * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]-2) * pow(Y[2],L[j][2]); - if (L[j][2] > 1) w += L[j][2] * (L[j][2]-1) * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]-2); - munit_assert_double_equal( VGL[j][4], w, 10 ); - } - free(L_mem); - free(VGL_mem); -} + test_qmckl_ao_polynomial_vgl = & + qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) + if (test_qmckl_ao_polynomial_vgl /= 0) return + + test_qmckl_ao_polynomial_vgl = -1 + + if (n /= d) return + + do j=1,n + do i=1,3 + if (L(i,j) < 0) return + end do + if (dabs(1.d0 - VGL(1,j) / (& + Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) & + )) > 1.d-14 ) return + + if (L(1,j) < 1) then + if (VGL(2,j) /= 0.d0) return + else + if (dabs(1.d0 - VGL(2,j) / (& + L(1,j) * Y(1)**(L(1,j)-1) * Y(2)**L(2,j) * Y(3)**L(3,j) & + )) > 1.d-14 ) return + end if + + if (L(2,j) < 1) then + if (VGL(3,j) /= 0.d0) return + else + if (dabs(1.d0 - VGL(3,j) / (& + L(2,j) * Y(1)**L(1,j) * Y(2)**(L(2,j)-1) * Y(3)**L(3,j) & + )) > 1.d-14 ) return + end if + + if (L(3,j) < 1) then + if (VGL(4,j) /= 0.d0) return + else + if (dabs(1.d0 - VGL(4,j) / (& + L(3,j) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-1) & + )) > 1.d-14 ) return + end if + + w = 0.d0 + if (L(1,j) > 1) then + w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j) + end if + if (L(2,j) > 1) then + w = w + L(2,j) * (L(2,j)-1) * Y(1)**L(1,j) * Y(2)**(L(2,j)-2) * Y(3)**L(3,j) + end if + if (L(3,j) > 1) then + w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2) + end if + if (dabs(1.d0 - VGL(5,j) / w) > 1.d-14 ) return + end do + + test_qmckl_ao_polynomial_vgl = 0 + + deallocate(L,VGL) +end function test_qmckl_ao_polynomial_vgl #+END_SRC + #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c +int test_qmckl_ao_polynomial_vgl(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); + #+END_SRC + #+END_SRC * TODO Gaussian basis functions diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index d69b133..b34b939 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -14,7 +14,8 @@ Function for the computation of distances between particles. 3 files are produced: - a header file : =qmckl_distance.h= - a source file : =qmckl_distance.f90= -- a test file : =test_qmckl_distance.c= +- a C test file : =test_qmckl_distance.c= +- a Fortran test file : =test_qmckl_distance_f.f90= *** Header :noexport: #+BEGIN_SRC C :comments link :tangle qmckl_distance.h @@ -23,10 +24,6 @@ Function for the computation of distances between particles. #include "qmckl_context.h" #+END_SRC -*** Source :noexport: - #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 - #+END_SRC - *** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c #include @@ -132,10 +129,10 @@ integer function qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) resu do j=1,n do i=1,m - x = A(i,1) - B(j,1) - y = A(i,2) - B(j,2) - z = A(i,3) - B(j,3) - C(i,j) = x*x + y*y + z*z + x = A(i,1) - B(j,1) + y = A(i,2) - B(j,2) + z = A(i,3) - B(j,3) + C(i,j) = x*x + y*y + z*z end do end do @@ -162,60 +159,77 @@ integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, end function qmckl_distance_sq #+END_SRC + #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.fh + interface + integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) & + bind(C) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: m, n + integer (c_int64_t) , intent(in) , value :: lda + integer (c_int64_t) , intent(in) , value :: ldb + integer (c_int64_t) , intent(in) , value :: ldc + real (c_double) , intent(in) :: A(lda,3) + real (c_double) , intent(in) :: B(ldb,3) + real (c_double) , intent(out) :: C(ldc,n) + end function qmckl_distance_sq + end interface + #+END_SRC + *** Test :noexport: - #+BEGIN_SRC f90 :comments link :tangle test_qmckl_distance_f.f90 - integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) - use iso_c_binding - implicit none - integer(c_int64_t), intent(in), value :: context + #+BEGIN_SRC f90 :comments link :tangle test_qmckl_distance_f.f90 +integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) + use, intrinsic :: iso_c_binding + implicit none + include 'qmckl_distance.fh' + integer(c_int64_t), intent(in), value :: context - double precision, allocatable :: A(:,:), B(:,:), C(:,:) - integer*8 :: m, n, LDA, LDB, LDC - double precision :: x - integer*8 :: i,j + double precision, allocatable :: A(:,:), B(:,:), C(:,:) + integer*8 :: m, n, LDA, LDB, LDC + double precision :: x + integer*8 :: i,j - integer, external :: qmckl_distance_sq_f + m = 5 + n = 6 + LDA = 6 + LDB = 10 + LDC = 5 - m = 5 - n = 6 - LDA = 6 - LDB = 10 - LDC = 5 + allocate( A(LDA,3), B(LDB,3), C(LDC,n) ) - allocate( A(LDA,3), B(LDB,3), C(LDC,n) ) + do j=1,3 + do i=1,m + A(i,j) = -10.d0 + dble(i+j) + end do + do i=1,n + B(i,j) = -1.d0 + dble(i*j) + end do + end do - do j=1,3 - do i=1,m - A(i,j) = -10.d0 + dble(i+j) - end do - do i=1,n - B(i,j) = -1.d0 + dble(i*j) - end do - end do + test_qmckl_distance_sq = qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq /= 0) return - test_qmckl_distance_sq = qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) - if (test_qmckl_distance_sq /= 0) return + test_qmckl_distance_sq = -1 - test_qmckl_distance_sq = -1 + do j=1,n + do i=1,m + 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-12 ) return + end do + end do + test_qmckl_distance_sq = 0 - do j=1,n - do i=1,m - 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-12 ) return - end do - end do - test_qmckl_distance_sq = 0 + deallocate(A,B,C) +end function test_qmckl_distance_sq + #+END_SRC - deallocate(A,B,C) - end function test_qmckl_distance_sq - #+END_SRC - - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c - int test_qmckl_distance_sq(qmckl_context context); - munit_assert_int(0, ==, test_qmckl_distance_sq(context)); - #+END_SRC + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c +int test_qmckl_distance_sq(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_distance_sq(context)); + #+END_SRC * End of files *** Header :noexport: From a20394f6362ec7b3f7856950119cb1312b06037a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 Oct 2020 19:36:25 +0100 Subject: [PATCH 27/61] Indentation --- src/qmckl_ao.org | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 5511e74..ee2c413 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -299,9 +299,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, vgl(3,n) = dble(b) * pows(a ,1) * pows(b-1,2) * pows(c ,3) vgl(4,n) = dble(c) * pows(a ,1) * pows(b ,2) * pows(c-1,3) - vgl(5,n) = dble(a) * dble(a-1) * pows(a-2,1) * pows(b ,2) * pows(c ,3) & - + dble(b) * dble(b-1) * pows(a ,1) * pows(b-2,2) * pows(c ,3) & - + dble(c) * dble(c-1) * pows(a ,1) * pows(b ,2) * pows(c-2,3) + vgl(5,n) = & + dble(a) * dble(a-1) * pows(a-2,1) * pows(b ,2) * pows(c ,3) + & + dble(b) * dble(b-1) * pows(a ,1) * pows(b-2,2) * pows(c ,3) + & + dble(c) * dble(c-1) * pows(a ,1) * pows(b ,2) * pows(c-2,3) exit end if end do From 1a16defe35237319041ab0c00d1174f0a575f4ac Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 Oct 2020 19:41:07 +0100 Subject: [PATCH 28/61] Precision in tests --- src/qmckl_distance.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index b34b939..5bdbb53 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -217,7 +217,7 @@ integer(c_int32_t) 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-12 ) return + if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return end do end do test_qmckl_distance_sq = 0 From 2cc816766fec1befc28b5a2359fd27f2605bdeb8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Mon, 26 Oct 2020 19:44:21 +0100 Subject: [PATCH 29/61] HTML Export file name --- src/Makefile | 2 +- src/README.org | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Makefile b/src/Makefile index c4e7fc1..6cf6be8 100644 --- a/src/Makefile +++ b/src/Makefile @@ -30,7 +30,7 @@ test: Makefile.generated $(MAKE) -f Makefile.generated test doc:$(ORG_SOURCE_FILES) - ./create_doc.sh $(ORG_SOURCE_FILES) + ./create_doc.sh README.org $(ORG_SOURCE_FILES) clean: rm -f qmckl.h test_qmckl_* test_qmckl.c qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh diff --git a/src/README.org b/src/README.org index 01aa7ae..a895586 100644 --- a/src/README.org +++ b/src/README.org @@ -1,4 +1,5 @@ #+TITLE: QMCkl source code documentation +#+EXPORT_FILE_NAME: index.html #+HTML_HEAD: #+HTML_HEAD: From 1db7d327e7bec46782afd131871aa8f0f607d2bd Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 27 Oct 2020 17:24:44 +0100 Subject: [PATCH 30/61] Syntax coloring in html --- src/config.el | 87 +++++++++++++++++++++++++++++++++++++++++++++++ src/create_doc.sh | 4 +-- 2 files changed, 89 insertions(+), 2 deletions(-) create mode 100755 src/config.el diff --git a/src/config.el b/src/config.el new file mode 100755 index 0000000..9395d1d --- /dev/null +++ b/src/config.el @@ -0,0 +1,87 @@ +(require 'org) +(require 'font-lock) + +(require 'subr-x) ;; for `when-let' + +(unless (boundp 'maximal-integer) + (defconst maximal-integer (lsh -1 -1) + "Maximal integer value representable natively in emacs lisp.")) + +(defun face-spec-default (spec) + "Get list containing at most the default entry of face SPEC. +Return nil if SPEC has no default entry." + (let* ((first (car-safe spec)) + (display (car-safe first))) + (when (eq display 'default) + (list (car-safe spec))))) + +(defun face-spec-min-color (display-atts) + "Get min-color entry of DISPLAY-ATTS pair from face spec." + (let* ((display (car-safe display-atts))) + (or (car-safe (cdr (assoc 'min-colors display))) + maximal-integer))) + +(defun face-spec-highest-color (spec) + "Search face SPEC for highest color. +That means the DISPLAY entry of SPEC +with class 'color and highest min-color value." + (let ((color-list (cl-remove-if-not + (lambda (display-atts) + (when-let ((display (car-safe display-atts)) + (class (and (listp display) + (assoc 'class display))) + (background (assoc 'background display))) + (and (member 'light (cdr background)) + (member 'color (cdr class))))) + spec))) + (cl-reduce (lambda (display-atts1 display-atts2) + (if (> (face-spec-min-color display-atts1) + (face-spec-min-color display-atts2)) + display-atts1 + display-atts2)) + (cdr color-list) + :initial-value (car color-list)))) + +(defun face-spec-t (spec) + "Search face SPEC for fall back." + (cl-find-if (lambda (display-atts) + (eq (car-safe display-atts) t)) + spec)) + +(defun my-face-attribute (face attribute &optional frame inherit) + "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'." + (let* ((face-spec (face-user-default-spec face)) + (display-attr (or (face-spec-highest-color face-spec) + (face-spec-t face-spec))) + (attr (cdr display-attr)) + (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr)))))) + ;; (message "attribute: %S" attribute) ;; for debugging + (when (and (null (eq attribute :inherit)) + (null val)) + (let ((inherited-face (my-face-attribute face :inherit))) + (when (and inherited-face + (null (eq inherited-face 'unspecified))) + (setq val (my-face-attribute inherited-face attribute))))) + ;; (message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging + (or val 'unspecified))) + +(advice-add 'face-attribute :override #'my-face-attribute) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Debugging: +(defmacro print-args-and-ret (fun) + "Prepare FUN for printing args and return value." + `(advice-add (quote ,fun) :around + (lambda (oldfun &rest args) + (let ((ret (apply oldfun args))) + (message ,(concat "Calling " (symbol-name fun) " with args %S returns %S.") args ret) + ret)) + '((name "print-args-and-ret")))) + +; (print-args-and-ret htmlize-faces-in-buffer) +; (print-args-and-ret htmlize-get-override-fstruct) +; (print-args-and-ret htmlize-face-to-fstruct) +; (print-args-and-ret htmlize-attrlist-to-fstruct) +; (print-args-and-ret face-foreground) +; (print-args-and-ret face-background) +; (print-args-and-ret face-attribute) diff --git a/src/create_doc.sh b/src/create_doc.sh index eddf509..8b7b146 100755 --- a/src/create_doc.sh +++ b/src/create_doc.sh @@ -3,8 +3,8 @@ # Tangle org files emacsclient -a "" \ - --socket-name=org_to_code \ - --eval "(require 'org)" + --socket-name=org_to_code \ + --eval "(load-file \"config.el\")" for INPUT in $@ ; do echo $INPUT From abc0e6b5ab2a0c0bc5112426c44320cfee2e31c8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Tue, 27 Oct 2020 17:35:49 +0100 Subject: [PATCH 31/61] Optimized polynomials --- src/qmckl_ao.org | 43 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 34 insertions(+), 9 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index ee2c413..9f2399b 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -39,7 +39,23 @@ MunitResult test_qmckl_ao() { * Polynomials - \[ P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c \] + \[ + P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c + \] + \begin{eqnarray*} + \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ + \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ + \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ + \end{eqnarray*} + \begin{eqnarray*} + \left( \frac{\partial }{\partial x^2} + + \frac{\partial }{\partial y^2} + + \frac{\partial }{\partial z^2} \right) P_l + \left(\mathbf{r},\mathbf{R}_i \right) & = & + a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ + && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ + && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} + \end{eqnarray*} ** =qmckl_ao_powers= @@ -244,6 +260,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, integer :: lmax_array(3) real*8 :: pows(-2:lmax,3) integer, external :: qmckl_ao_powers_f + double precision :: xy, yz, xz info = 0 @@ -293,16 +310,24 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, l(2,n) = b l(3,n) = c - vgl(1,n) = pows(a,1) * pows(b,2) * pows(c,3) + xy = pows(a,1) * pows(b,2) + yz = pows(b,2) * pows(c,3) + xz = pows(a,1) * pows(c,3) - vgl(2,n) = dble(a) * pows(a-1,1) * pows(b ,2) * pows(c ,3) - vgl(3,n) = dble(b) * pows(a ,1) * pows(b-1,2) * pows(c ,3) - vgl(4,n) = dble(c) * pows(a ,1) * pows(b ,2) * pows(c-1,3) + vgl(1,n) = xy * pows(c,3) + + xy = dble(c) * xy + xz = dble(b) * xz + yz = dble(a) * yz + + vgl(2,n) = pows(a-1,1) * yz + vgl(3,n) = pows(b-1,2) * xz + vgl(4,n) = pows(c-1,3) * xy vgl(5,n) = & - dble(a) * dble(a-1) * pows(a-2,1) * pows(b ,2) * pows(c ,3) + & - dble(b) * dble(b-1) * pows(a ,1) * pows(b-2,2) * pows(c ,3) + & - dble(c) * dble(c-1) * pows(a ,1) * pows(b ,2) * pows(c-2,3) + dble(a-1) * pows(a-2,1) * yz + & + dble(b-1) * pows(b-2,2) * xz + & + dble(c-1) * pows(c-2,3) * xy exit end if end do @@ -443,7 +468,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); #+END_SRC #+END_SRC - + * TODO Gaussian basis functions * TODO Slater basis functions From 8147ad22a72b9a4a03652a6f8c962dee9079ea0b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Oct 2020 19:28:27 +0100 Subject: [PATCH 32/61] Optimizations in polynomials --- TODO.org | 5 +++ src/qmckl_ao.org | 91 +++++++++++++++++++++++++----------------------- 2 files changed, 53 insertions(+), 43 deletions(-) diff --git a/TODO.org b/TODO.org index 2d5626b..250dd79 100644 --- a/TODO.org +++ b/TODO.org @@ -10,3 +10,8 @@ qmckl_malloc, where the domain id is something obtained from the context. +* TRANSA, TRANSB +* Performance info +* Benchmark interpolation of basis functions +* Complex numbers + diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 9f2399b..c8e57a4 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -85,9 +85,9 @@ MunitResult test_qmckl_ao() { *** Header #+BEGIN_SRC C :comments link :tangle qmckl_ao.h qmckl_exit_code qmckl_ao_powers(qmckl_context context, - int64_t n, - double *X, int32_t *LMAX, - double *P, int64_t LDP); + int64_t n, + double *X, int32_t *LMAX, + double *P, int64_t LDP); #+END_SRC *** Source @@ -235,10 +235,10 @@ munit_assert_int(0, ==, test_qmckl_ao_powers(context)); *** Header #+BEGIN_SRC C :comments link :tangle qmckl_ao.h qmckl_exit_code qmckl_ao_polynomial_vgl(qmckl_context context, - double *X, double *R, - int32_t lmax, int64_t *n, - int32_t *L, int64_t ldl, - double *VGL, int64_t ldv); + double *X, double *R, + int32_t lmax, int64_t *n, + int32_t *L, int64_t ldl, + double *VGL, int64_t ldv); #+END_SRC *** Source @@ -261,27 +261,28 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, real*8 :: pows(-2:lmax,3) integer, external :: qmckl_ao_powers_f double precision :: xy, yz, xz - + double precision :: da, db, dc, dd + info = 0 - + if (context == 0_8) then info = -1 return endif - + n = (lmax+1)*(lmax+2)*(lmax+3)/6 - + if (ldl < 3) then info = -2 return endif - + if (ldv < 5) then info = -3 return endif - - + + do i=1,3 Y(i) = X(i) - R(i) end do @@ -300,39 +301,43 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, vgl(1:5,1:n) = 0.d0 l(1:3,n) = 0 vgl(1,n) = 1.d0 + dd = 1.d0 do d=1,lmax + da = 0.d0 do a=0,d - do b=0,d - do c=0,d - if (a+b+c == d) then - n = n+1 - l(1,n) = a - l(2,n) = b - l(3,n) = c + db = 0.d0 + do b=0,d-a + c = d - a - b + dc = dd - da - db + n = n+1 + l(1,n) = a + l(2,n) = b + l(3,n) = c + + xy = pows(a,1) * pows(b,2) + yz = pows(b,2) * pows(c,3) + xz = pows(a,1) * pows(c,3) + + vgl(1,n) = xy * pows(c,3) + + xy = dc * xy + xz = db * xz + yz = da * yz + + vgl(2,n) = pows(a-1,1) * yz + vgl(3,n) = pows(b-1,2) * xz + vgl(4,n) = pows(c-1,3) * xy + + vgl(5,n) = & + (da-1.d0) * pows(a-2,1) * yz + & + (db-1.d0) * pows(b-2,2) * xz + & + (dc-1.d0) * pows(c-2,3) * xy - xy = pows(a,1) * pows(b,2) - yz = pows(b,2) * pows(c,3) - xz = pows(a,1) * pows(c,3) - - vgl(1,n) = xy * pows(c,3) - - xy = dble(c) * xy - xz = dble(b) * xz - yz = dble(a) * yz - - vgl(2,n) = pows(a-1,1) * yz - vgl(3,n) = pows(b-1,2) * xz - vgl(4,n) = pows(c-1,3) * xy - - vgl(5,n) = & - dble(a-1) * pows(a-2,1) * yz + & - dble(b-1) * pows(b-2,2) * xz + & - dble(c-1) * pows(c-2,3) * xy - exit - end if - end do - end do + db = db + 1.d0 + end do + da = da + 1.d0 end do + dd = dd + 1.d0 end do end function qmckl_ao_polynomial_vgl_f From 3aaaabfad34750d993101cf30d63383b4103c5fc Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 28 Oct 2020 20:15:36 +0100 Subject: [PATCH 33/61] Added transa/transb in distances --- TODO.org | 1 + src/qmckl_distance.org | 195 ++++++++++++++++++++++++++++++++++------- 2 files changed, 164 insertions(+), 32 deletions(-) diff --git a/TODO.org b/TODO.org index 250dd79..1fad144 100644 --- a/TODO.org +++ b/TODO.org @@ -14,4 +14,5 @@ context. * Performance info * Benchmark interpolation of basis functions * Complex numbers +* Adjustable number for derivatives (1,2,3) diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 5bdbb53..6795b98 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -43,12 +43,14 @@ MunitResult test_qmckl_distance() { Computes the matrix of the squared distances between all pairs of points in two sets, one point within each set: \[ - C_{ij} = \sum_{k=1}^3 (A_{i,k}-B_{j,k})^2 + C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 \] *** Arguments | =context= | input | Global state | + | =transa= | input | Array =A= is =N=: Normal, =T=: Transposed | + | =transb= | input | Array =B= is =N=: Normal, =T=: Transposed | | =m= | input | Number of points in the first set | | =n= | input | Number of points in the second set | | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | @@ -63,16 +65,24 @@ MunitResult test_qmckl_distance() { - =context= is not 0 - =m= > 0 - =n= > 0 - - =lda= >= m - - =ldb= >= n - - =ldc= >= m + - =lda= >= 3 if =transa= is =N= + - =lda= >= m if =transa= is =T= + - =ldb= >= 3 if =transb= is =N= + - =ldb= >= n if =transb= is =T= + - =ldc= >= m if =transa= is = - =A= is allocated with at least $3 \times m \times 8$ bytes - =B= is allocated with at least $3 \times n \times 8$ bytes - =C= is allocated with at least $m \times n \times 8$ bytes +*** Performance + + This function might be more efficient when =A= and =B= are + transposed. + *** Header #+BEGIN_SRC C :comments link :tangle qmckl_distance.h qmckl_exit_code qmckl_distance_sq(qmckl_context context, + char transa, char transb, int64_t m, int64_t n, double *A, int64_t lda, double *B, int64_t ldb, @@ -81,19 +91,21 @@ qmckl_exit_code qmckl_distance_sq(qmckl_context context, *** Source #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 -integer function qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) result(info) +integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) implicit none integer*8 , intent(in) :: context + character , intent(in) :: transa, transb integer*8 , intent(in) :: m, n integer*8 , intent(in) :: lda - real*8 , intent(in) :: A(lda,3) + real*8 , intent(in) :: A(lda,*) integer*8 , intent(in) :: ldb - real*8 , intent(in) :: B(ldb,3) + real*8 , intent(in) :: B(ldb,*) integer*8 , intent(in) :: ldc - real*8 , intent(out) :: C(ldc,n) + real*8 , intent(out) :: C(ldc,*) integer*8 :: i,j real*8 :: x, y, z + integer :: transab info = 0 @@ -112,40 +124,107 @@ integer function qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) resu return endif - if (LDA < m) then - info = -4 - return + if (transa == 'N' .or. transa == 'n') then + transab = 0 + else if (transa == 'T' .or. transa == 't') then + transab = 1 + else + transab = -100 endif - if (LDB < n) then + if (transb == 'N' .or. transb == 'n') then + continue + else if (transa == 'T' .or. transa == 't') then + transab = transab + 2 + else + transab = -100 + endif + + if (transab < 0) then + info = -4 + return + endif + + if (iand(transab,1) == 0 .and. LDA < 3) then info = -5 return endif - if (LDC < m) then + if (iand(transab,1) == 1 .and. LDA < m) then info = -6 return endif - do j=1,n - do i=1,m - x = A(i,1) - B(j,1) - y = A(i,2) - B(j,2) - z = A(i,3) - B(j,3) - C(i,j) = x*x + y*y + z*z - end do - end do + if (iand(transab,2) == 0 .and. LDA < 3) then + info = -6 + return + endif + if (iand(transab,2) == 2 .and. LDA < m) then + info = -7 + return + endif + + + select case (transab) + + case(0) + + do j=1,n + do i=1,m + x = A(1,i) - B(1,j) + y = A(2,i) - B(2,j) + z = A(3,i) - B(3,j) + C(i,j) = x*x + y*y + z*z + end do + end do + + case(1) + + do j=1,n + do i=1,m + x = A(i,1) - B(1,j) + y = A(i,2) - B(2,j) + z = A(i,3) - B(3,j) + C(i,j) = x*x + y*y + z*z + end do + end do + + case(2) + + do j=1,n + do i=1,m + x = A(1,i) - B(j,1) + y = A(2,i) - B(j,2) + z = A(3,i) - B(j,3) + C(i,j) = x*x + y*y + z*z + end do + end do + + case(3) + + do j=1,n + do i=1,m + x = A(i,1) - B(j,1) + y = A(i,2) - B(j,2) + z = A(i,3) - B(j,3) + C(i,j) = x*x + y*y + z*z + end do + end do + + end select + end function qmckl_distance_sq_f #+END_SRC *** C interface :noexport: #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 -integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) & +integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) result(info) use, intrinsic :: iso_c_binding implicit none integer (c_int64_t) , intent(in) , value :: context + character (c_char) , intent(in) , value :: transa, transb integer (c_int64_t) , intent(in) , value :: m, n integer (c_int64_t) , intent(in) , value :: lda real (c_double) , intent(in) :: A(lda,3) @@ -155,17 +234,18 @@ integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, real (c_double) , intent(out) :: C(ldc,n) integer, external :: qmckl_distance_sq_f - info = qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) + info = qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) end function qmckl_distance_sq #+END_SRC #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.fh interface - integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) & + integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) use, intrinsic :: iso_c_binding implicit none integer (c_int64_t) , intent(in) , value :: context + character (c_char) , intent(in) , value :: transa, transb integer (c_int64_t) , intent(in) , value :: m, n integer (c_int64_t) , intent(in) , value :: lda integer (c_int64_t) , intent(in) , value :: ldb @@ -192,22 +272,30 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) m = 5 n = 6 - LDA = 6 - LDB = 10 + LDA = m + LDB = n LDC = 5 - allocate( A(LDA,3), B(LDB,3), C(LDC,n) ) + allocate( A(LDA,m), B(LDB,n), C(LDC,n) ) - do j=1,3 + do j=1,m do i=1,m A(i,j) = -10.d0 + dble(i+j) end do + end do + do j=1,n do i=1,n B(i,j) = -1.d0 + dble(i*j) end do end do - test_qmckl_distance_sq = qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) + test_qmckl_distance_sq = qmckl_distance_sq(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq == 0) return + + test_qmckl_distance_sq = qmckl_distance_sq(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC) + if (test_qmckl_distance_sq == 0) return + + 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 test_qmckl_distance_sq = -1 @@ -220,6 +308,49 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return 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 + + test_qmckl_distance_sq = -1 + + do j=1,n + do i=1,m + 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 + 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 + + test_qmckl_distance_sq = -1 + + do j=1,n + do i=1,m + 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 + 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 + + test_qmckl_distance_sq = -1 + + do j=1,n + do i=1,m + x = (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 + end do + end do + test_qmckl_distance_sq = 0 deallocate(A,B,C) @@ -230,14 +361,14 @@ end function test_qmckl_distance_sq int test_qmckl_distance_sq(qmckl_context context); munit_assert_int(0, ==, test_qmckl_distance_sq(context)); #+END_SRC -* End of files +* End of files :noexport: -*** Header :noexport: +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_distance.h #endif #+END_SRC -*** Test :noexport: +*** Test #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; From 7df788b42a389aa603527663ff3dff568d2b77c6 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Oct 2020 00:20:20 +0100 Subject: [PATCH 34/61] Add publication of documentation on gh-pages --- .github/workflows/test-build.yml | 7 +++++++ docs/.gitignore | 0 src/create_doc.sh | 1 + 3 files changed, 8 insertions(+) create mode 100644 docs/.gitignore diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index 3f9a036..3346ada 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -17,6 +17,13 @@ jobs: run: sudo apt-get install emacs - name: make run: make -C src/ + - name: deploy docs + uses: ./ + run: make -C src/ doc + with: + username: scemama + password: 7da28e533792db220a4811fc4e487b8ba817862f + remote_url: https://github.com/appleboy/gh-pages-action.git test: diff --git a/docs/.gitignore b/docs/.gitignore new file mode 100644 index 0000000..e69de29 diff --git a/src/create_doc.sh b/src/create_doc.sh index 8b7b146..e85ff5b 100755 --- a/src/create_doc.sh +++ b/src/create_doc.sh @@ -14,6 +14,7 @@ for INPUT in $@ ; do --eval "(find-file \"$INPUT\")" \ --eval "(org-html-export-to-html)" done +mv *.html ../docs emacsclient \ --no-wait \ From dbe53976530b358e81b3a4357ec1e24448047b14 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Oct 2020 00:21:22 +0100 Subject: [PATCH 35/61] Add publication of documentation on gh-pages --- .github/workflows/test-build.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index 3346ada..a5b0c8c 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -17,9 +17,10 @@ jobs: run: sudo apt-get install emacs - name: make run: make -C src/ + - name: build docs + run: make -C src/ doc - name: deploy docs uses: ./ - run: make -C src/ doc with: username: scemama password: 7da28e533792db220a4811fc4e487b8ba817862f From 945d391f6366292f2be3167181456896254dab92 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Oct 2020 00:28:46 +0100 Subject: [PATCH 36/61] Add publication of documentation on gh-pages --- .github/workflows/test-build.yml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index a5b0c8c..943ae07 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -13,12 +13,22 @@ jobs: steps: - uses: actions/checkout@v2 + - name: install dependencies run: sudo apt-get install emacs + - name: make run: make -C src/ + - name: build docs run: make -C src/ doc + + - name: GitHub Pages Deploy + uses: appleboy/gh-pages-action@v0.0.2 + + - name: checkout + uses: actions/checkout@v1 + - name: deploy docs uses: ./ with: @@ -26,6 +36,7 @@ jobs: password: 7da28e533792db220a4811fc4e487b8ba817862f remote_url: https://github.com/appleboy/gh-pages-action.git + test: runs-on: ubuntu-latest From e3754febfc4ea17d6e180fe745204da370b8b689 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Oct 2020 00:56:48 +0100 Subject: [PATCH 37/61] Add gh-pages workflow --- .github/workflows/gh-pages.yml | 25 +++++++++++++++++++++++++ .github/workflows/test-build.yml | 16 ---------------- 2 files changed, 25 insertions(+), 16 deletions(-) create mode 100644 .github/workflows/gh-pages.yml diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml new file mode 100644 index 0000000..7d269b4 --- /dev/null +++ b/.github/workflows/gh-pages.yml @@ -0,0 +1,25 @@ +name: github pages + +on: + push: + branches: + - main # Set a branch name to trigger deployment + +jobs: + deploy: + runs-on: ubuntu-18.04 + steps: + - uses: actions/checkout@v2 + + - name: install dependencies + run: sudo apt-get install emacs + + - name: make + run: make -C src/ doc + + - name: Deploy + uses: peaceiris/actions-gh-pages@v3 + with: + github_token: ${{ secrets.GITHUB_TOKEN }} + publish_dir: ./docs + diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index 943ae07..de8c820 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -20,22 +20,6 @@ jobs: - name: make run: make -C src/ - - name: build docs - run: make -C src/ doc - - - name: GitHub Pages Deploy - uses: appleboy/gh-pages-action@v0.0.2 - - - name: checkout - uses: actions/checkout@v1 - - - name: deploy docs - uses: ./ - with: - username: scemama - password: 7da28e533792db220a4811fc4e487b8ba817862f - remote_url: https://github.com/appleboy/gh-pages-action.git - test: From 7e0a0425bc9525175eb3f1ae827136e391c56138 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Oct 2020 01:02:44 +0100 Subject: [PATCH 38/61] Change docs --- .github/workflows/gh-pages.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 7d269b4..17d2d09 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -3,11 +3,11 @@ name: github pages on: push: branches: - - main # Set a branch name to trigger deployment + - main jobs: deploy: - runs-on: ubuntu-18.04 + runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 From 2b6a96518d36f5db26a7327becab662b43190565 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Oct 2020 01:06:18 +0100 Subject: [PATCH 39/61] emacs26 in gh-pages --- .github/workflows/gh-pages.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 17d2d09..3e37812 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -3,7 +3,7 @@ name: github pages on: push: branches: - - main + - main jobs: deploy: @@ -12,7 +12,7 @@ jobs: - uses: actions/checkout@v2 - name: install dependencies - run: sudo apt-get install emacs + run: sudo apt-get install emacs26 - name: make run: make -C src/ doc From a62c762b05053cf24c2852586aa709eff4cc8712 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 29 Oct 2020 01:14:47 +0100 Subject: [PATCH 40/61] Update gh-pages.yml --- .github/workflows/gh-pages.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 3e37812..f686184 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -12,7 +12,7 @@ jobs: - uses: actions/checkout@v2 - name: install dependencies - run: sudo apt-get install emacs26 + run: sudo apt-get install emacs - name: make run: make -C src/ doc From 7a5b5b096ced8e73f24ac6712fd9d0ba969248ea Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 30 Oct 2020 16:22:29 +0100 Subject: [PATCH 41/61] Changed tabs into spaces --- src/create_doc.sh | 8 +++---- src/create_makefile.sh | 6 ++--- src/qmckl_context.org | 7 ++++++ src/qmckl_distance.org | 54 +++++++++++++++++++++--------------------- 4 files changed, 41 insertions(+), 34 deletions(-) diff --git a/src/create_doc.sh b/src/create_doc.sh index e85ff5b..ab6ba4d 100755 --- a/src/create_doc.sh +++ b/src/create_doc.sh @@ -9,10 +9,10 @@ emacsclient -a "" \ for INPUT in $@ ; do echo $INPUT emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval "(find-file \"$INPUT\")" \ - --eval "(org-html-export-to-html)" + --no-wait \ + --socket-name=org_to_code \ + --eval "(find-file \"$INPUT\")" \ + --eval "(org-html-export-to-html)" done mv *.html ../docs diff --git a/src/create_makefile.sh b/src/create_makefile.sh index 3ff14b9..60653d2 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -10,9 +10,9 @@ emacsclient -a "" \ for INPUT in $@ ; do emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval "(org-babel-tangle-file \"$INPUT\")" + --no-wait \ + --socket-name=org_to_code \ + --eval "(org-babel-tangle-file \"$INPUT\")" done emacsclient \ diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 00ca914..e839078 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -391,6 +391,13 @@ int qmckl_context_get_range(const qmckl_context context) { *** TODO Tests :noexport: + +* Info about the molecular system + +** TODO =qmckl_context_set_nucl_coord= +** TODO =qmckl_context_set_nucl_charge= +** TODO =qmckl_context_set_elec_num= + * End of files :noexport: *** Header diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 6795b98..8bee0eb 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -11,7 +11,7 @@ Function for the computation of distances between particles. -3 files are produced: +4 files are produced: - a header file : =qmckl_distance.h= - a source file : =qmckl_distance.f90= - a C test file : =test_qmckl_distance.c= @@ -82,11 +82,11 @@ MunitResult test_qmckl_distance() { *** Header #+BEGIN_SRC C :comments link :tangle qmckl_distance.h qmckl_exit_code qmckl_distance_sq(qmckl_context context, - char transa, char transb, - int64_t m, int64_t n, - double *A, int64_t lda, - double *B, int64_t ldb, - double *C, int64_t ldc); + char transa, char transb, + int64_t m, int64_t n, + double *A, int64_t lda, + double *B, int64_t ldb, + double *C, int64_t ldc); #+END_SRC *** Source @@ -280,12 +280,12 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) do j=1,m do i=1,m - A(i,j) = -10.d0 + dble(i+j) + A(i,j) = -10.d0 + dble(i+j) end do end do do j=1,n do i=1,n - B(i,j) = -1.d0 + dble(i*j) + B(i,j) = -1.d0 + dble(i*j) end do end do @@ -302,10 +302,10 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) do j=1,n do i=1,m - 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 + 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 end do end do @@ -316,10 +316,10 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) do j=1,n do i=1,m - 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 + 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 end do end do @@ -330,10 +330,10 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) do j=1,n do i=1,m - 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 + 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 end do end do @@ -344,19 +344,19 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) do j=1,n do i=1,m - x = (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 + x = (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 end do end do - + test_qmckl_distance_sq = 0 - + deallocate(A,B,C) end function test_qmckl_distance_sq #+END_SRC - + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c int test_qmckl_distance_sq(qmckl_context context); munit_assert_int(0, ==, test_qmckl_distance_sq(context)); From d11bcab9133a4fdd54d5023bfad3bd6e46f048ae Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 31 Oct 2020 19:01:26 +0100 Subject: [PATCH 42/61] Added a to_be_processes directory --- to_be_processed/.gitignore | 0 1 file changed, 0 insertions(+), 0 deletions(-) create mode 100644 to_be_processed/.gitignore diff --git a/to_be_processed/.gitignore b/to_be_processed/.gitignore new file mode 100644 index 0000000..e69de29 From 00a051af49cb9c54380b5a4effc599e3c741b383 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 31 Oct 2020 19:07:57 +0100 Subject: [PATCH 43/61] Added const attributes --- src/qmckl_ao.org | 18 +++++++++--------- src/qmckl_context.org | 19 ++++++++++++------- src/qmckl_distance.org | 12 ++++++------ 3 files changed, 27 insertions(+), 22 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index c8e57a4..b14f440 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -84,10 +84,10 @@ MunitResult test_qmckl_ao() { *** Header #+BEGIN_SRC C :comments link :tangle qmckl_ao.h -qmckl_exit_code qmckl_ao_powers(qmckl_context context, - int64_t n, - double *X, int32_t *LMAX, - double *P, int64_t LDP); +qmckl_exit_code qmckl_ao_powers(const qmckl_context context, + const int64_t n, + const double *X, const int32_t *LMAX, + const double *P, const int64_t LDP); #+END_SRC *** Source @@ -234,11 +234,11 @@ munit_assert_int(0, ==, test_qmckl_ao_powers(context)); *** Header #+BEGIN_SRC C :comments link :tangle qmckl_ao.h -qmckl_exit_code qmckl_ao_polynomial_vgl(qmckl_context context, - double *X, double *R, - int32_t lmax, int64_t *n, - int32_t *L, int64_t ldl, - double *VGL, int64_t ldv); +qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, + const double *X, const double *R, + const int32_t lmax, const int64_t *n, + const int32_t *L, const int64_t ldl, + const double *VGL, const int64_t ldv); #+END_SRC *** Source diff --git a/src/qmckl_context.org b/src/qmckl_context.org index e839078..ad35918 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -275,11 +275,12 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. ** =qmckl_context_update_precision= -*** Source +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { qmckl_context_struct* ctx; @@ -297,11 +298,12 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons *** TODO Tests :noexport: ** =qmckl_context_update_range= -*** Source +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); #+END_SRC +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { qmckl_context_struct* ctx; @@ -319,11 +321,12 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in *** TODO Tests :noexport: ** =qmckl_context_set_precision= -*** Source +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context new_context; @@ -339,11 +342,12 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int *** TODO Tests :noexport: ** =qmckl_context_set_range= -*** Source +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context; @@ -360,11 +364,12 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran *** TODO Tests :noexport: ** =qmckl_context_get_precision= -*** Source +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h int qmckl_context_get_precision(const qmckl_context context); #+END_SRC +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c int qmckl_context_get_precision(const qmckl_context context) { qmckl_context_struct* ctx; @@ -375,12 +380,12 @@ int qmckl_context_get_precision(const qmckl_context context) { *** TODO Tests :noexport: ** =qmckl_context_get_range= -*** Source - +*** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h int qmckl_context_get_range(const qmckl_context context); #+END_SRC +*** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c int qmckl_context_get_range(const qmckl_context context) { qmckl_context_struct* ctx; diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 8bee0eb..847ca30 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -81,12 +81,12 @@ MunitResult test_qmckl_distance() { *** Header #+BEGIN_SRC C :comments link :tangle qmckl_distance.h -qmckl_exit_code qmckl_distance_sq(qmckl_context context, - char transa, char transb, - int64_t m, int64_t n, - double *A, int64_t lda, - double *B, int64_t ldb, - double *C, int64_t ldc); +qmckl_exit_code qmckl_distance_sq(const qmckl_context context, + const char transa, const char transb, + const int64_t m, const int64_t n, + const double *A, const int64_t lda, + const double *B, const int64_t ldb, + const double *C, const int64_t ldc); #+END_SRC *** Source From 2467214b3a0741bd65f7304ac054adabbb3449e0 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 00:46:19 +0100 Subject: [PATCH 44/61] Introduced Gaussian basis functions --- src/.gitignore | 1 + src/Makefile | 10 +- src/README.org | 5 + src/qmckl_ao.org | 317 +++++++++++++++++++++++++++++++++++++----- src/qmckl_context.org | 193 +++++++++++++++++++------ 5 files changed, 442 insertions(+), 84 deletions(-) diff --git a/src/.gitignore b/src/.gitignore index 90eb50e..0304f4e 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -2,6 +2,7 @@ *.c *.f90 *.h +*.fh *.html *~ *.so diff --git a/src/Makefile b/src/Makefile index 6cf6be8..66a009a 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,8 +1,8 @@ -CC=gcc -CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g +CC=gcc -g +CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -FC=gfortran -FFLAGS=-fPIC -g -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan +FC=gfortran -g +FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan LIBS=-lgfortran -lm @@ -33,7 +33,7 @@ doc:$(ORG_SOURCE_FILES) ./create_doc.sh README.org $(ORG_SOURCE_FILES) clean: - rm -f qmckl.h test_qmckl_* test_qmckl.c qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh + rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh ./create_makefile.sh $(ORG_SOURCE_FILES) diff --git a/src/README.org b/src/README.org index a895586..3601733 100644 --- a/src/README.org +++ b/src/README.org @@ -80,6 +80,9 @@ rm ${nb}.md Fortran interface files should also be written in a file with a =.fh= extension. + For more guidelines on using Fortran to generate a C interface, see + [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]] + ** Coding style # TODO: decide on a coding style @@ -124,6 +127,8 @@ rm ${nb}.md 32-bit architectures) - ASCII strings are represented as a pointers to a character arrays and terminated by a zero character (C convention). + + Complex numbers can be represented by an array of 2 floats. # TODO : Link to repositories for bindings To facilitate the use in other languages than C, we provide some diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index b14f440..5c39a62 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -162,6 +162,7 @@ end function qmckl_ao_powers integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) use, intrinsic :: iso_c_binding implicit none + include 'qmckl_context.fh' include 'qmckl_ao.fh' integer(c_int64_t), intent(in), value :: context @@ -170,7 +171,10 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) integer, allocatable :: LMAX(:) double precision, allocatable :: X(:), P(:,:) integer*8 :: i,j - + double precision :: epsilon + + epsilon = qmckl_context_get_epsilon(context) + n = 100; LDP = 10; @@ -178,7 +182,7 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) do j=1,n X(j) = -5.d0 + 0.1d0 * dble(j) - LMAX(j) = 1 + int(mod(j, 9),4) + LMAX(j) = 1 + int(mod(j, 5),4) end do test_qmckl_ao_powers = qmckl_ao_powers(context, n, X, LMAX, P, LDP) @@ -188,7 +192,11 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) do j=1,n do i=1,LMAX(j) - if ( dabs(1.d0 - P(i,j) / (X(j)**i)) > 1.d-14 ) return + if ( X(j)**i == 0.d0 ) then + if ( P(i,j) /= 0.d0) return + else + if ( dabs(1.d0 - P(i,j) / (X(j)**i)) > epsilon ) return + end if end do end do @@ -202,6 +210,7 @@ int test_qmckl_ao_powers(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_powers(context)); #+END_SRC + ** =qmckl_ao_polynomial_vgl= Computes the values, gradients and Laplacians at a given point of @@ -216,21 +225,21 @@ munit_assert_int(0, ==, test_qmckl_ao_powers(context)); | =n= | output | Number of computed polynomials | | =L(ldl,n)= | output | Contains a,b,c for all =n= results | | =ldl= | input | Leading dimension of =L= | - | =VGL(ldv,n)= | output | Value, gradients and Laplacian of the polynomials | + | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials | | =ldv= | input | Leading dimension of array =VGL= | *** Requirements - =context= is not 0 - =n= > 0 + - =lmax= >= 0 + - =ldl= >= 3 + - =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 - =X= is allocated with at least $3 \times 8$ bytes - =R= is allocated with at least $3 \times 8$ bytes - - =lmax= >= 0 - - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 - =L= is allocated with at least $3 \times n \times 4$ bytes - - =ldl= >= 3 - - =VGL= is allocated with at least $5 \times n \times 8$ bytes - - =ldv= >= 5 + - =VGL= is allocated with at least $n \times 5 \times 8$ bytes + - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 *** Header #+BEGIN_SRC C :comments link :tangle qmckl_ao.h @@ -238,7 +247,7 @@ qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, const double *X, const double *R, const int32_t lmax, const int64_t *n, const int32_t *L, const int64_t ldl, - const double *VGL, const int64_t ldv); + const double *VGL, const int64_t ldv); #+END_SRC *** Source @@ -251,7 +260,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, integer*8 , intent(out) :: n integer , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) integer*8 , intent(in) :: ldl - real*8 , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + real*8 , intent(out) :: VGL(ldv,5) integer*8 , intent(in) :: ldv integer*8 :: i,j @@ -270,18 +279,21 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, return endif - n = (lmax+1)*(lmax+2)*(lmax+3)/6 - if (ldl < 3) then info = -2 return endif - if (ldv < 5) then + if (ldv < (lmax+1)*(lmax+2)*(lmax+3)/6) then info = -3 return endif + if (lmax <= 0) then + info = -4 + return + endif + do i=1,3 Y(i) = X(i) - R(i) @@ -297,10 +309,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, if (info /= 0) return + vgl(1,1) = 1.d0 + vgl(1,2:5) = 0.d0 + l(1:3,1) = 0 n=1 - vgl(1:5,1:n) = 0.d0 - l(1:3,n) = 0 - vgl(1,n) = 1.d0 dd = 1.d0 do d=1,lmax da = 0.d0 @@ -318,17 +330,17 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, yz = pows(b,2) * pows(c,3) xz = pows(a,1) * pows(c,3) - vgl(1,n) = xy * pows(c,3) + vgl(n,1) = xy * pows(c,3) xy = dc * xy xz = db * xz yz = da * yz - vgl(2,n) = pows(a-1,1) * yz - vgl(3,n) = pows(b-1,2) * xz - vgl(4,n) = pows(c-1,3) * xy + vgl(n,2) = pows(a-1,1) * yz + vgl(n,3) = pows(b-1,2) * xz + vgl(n,4) = pows(c-1,3) * xy - vgl(5,n) = & + vgl(n,5) = & (da-1.d0) * pows(a-2,1) * yz + & (db-1.d0) * pows(b-2,2) * xz + & (dc-1.d0) * pows(c-2,3) * xy @@ -340,6 +352,13 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, dd = dd + 1.d0 end do + if (n /= (lmax+1)*(lmax+2)*(lmax+3)/6) then + info = -5 + return + endif + + info = 0 + end function qmckl_ao_polynomial_vgl_f #+END_SRC @@ -355,7 +374,7 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l integer (c_int64_t) , intent(out) :: n integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) integer (c_int64_t) , intent(in) , value :: ldl - real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + real (c_double) , intent(out) :: VGL(ldv,5) integer (c_int64_t) , intent(in) , value :: ldv integer, external :: qmckl_ao_polynomial_vgl_f @@ -375,7 +394,7 @@ end function qmckl_ao_polynomial_vgl real (c_double) , intent(in) :: X(3), R(3) integer (c_int64_t) , intent(out) :: n integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) + real (c_double) , intent(out) :: VGL(ldv,5) end function qmckl_ao_polynomial_vgl end interface #+END_SRC @@ -384,6 +403,7 @@ end function qmckl_ao_polynomial_vgl integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use, intrinsic :: iso_c_binding implicit none + include 'qmckl_context.fh' include 'qmckl_ao.fh' integer(c_int64_t), intent(in), value :: context @@ -394,6 +414,9 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) double precision :: X(3), R(3), Y(3) double precision, allocatable :: VGL(:,:) double precision :: w + double precision :: epsilon + + epsilon = qmckl_context_get_epsilon(context) X = (/ 1.1 , 2.2 , 3.3 /) R = (/ 0.1 , 1.2 , -2.3 /) @@ -406,7 +429,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) d = (lmax+1)*(lmax+2)*(lmax+3)/6 - allocate (L(ldl,100), VGL(ldv,100)) + allocate (L(ldl,100), VGL(ldv,5)) test_qmckl_ao_polynomial_vgl = & qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) @@ -417,37 +440,43 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) if (n /= d) return do j=1,n + test_qmckl_ao_polynomial_vgl = -11 do i=1,3 if (L(i,j) < 0) return end do - if (dabs(1.d0 - VGL(1,j) / (& + test_qmckl_ao_polynomial_vgl = -12 + if (dabs(1.d0 - VGL(j,1) / (& Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) & - )) > 1.d-14 ) return + )) > epsilon ) return + test_qmckl_ao_polynomial_vgl = -13 if (L(1,j) < 1) then - if (VGL(2,j) /= 0.d0) return + if (VGL(j,2) /= 0.d0) return else - if (dabs(1.d0 - VGL(2,j) / (& + if (dabs(1.d0 - VGL(j,2) / (& L(1,j) * Y(1)**(L(1,j)-1) * Y(2)**L(2,j) * Y(3)**L(3,j) & - )) > 1.d-14 ) return + )) > epsilon ) return end if + test_qmckl_ao_polynomial_vgl = -14 if (L(2,j) < 1) then - if (VGL(3,j) /= 0.d0) return + if (VGL(j,3) /= 0.d0) return else - if (dabs(1.d0 - VGL(3,j) / (& + if (dabs(1.d0 - VGL(j,3) / (& L(2,j) * Y(1)**L(1,j) * Y(2)**(L(2,j)-1) * Y(3)**L(3,j) & - )) > 1.d-14 ) return + )) > epsilon ) return end if + test_qmckl_ao_polynomial_vgl = -15 if (L(3,j) < 1) then - if (VGL(4,j) /= 0.d0) return + if (VGL(j,4) /= 0.d0) return else - if (dabs(1.d0 - VGL(4,j) / (& + if (dabs(1.d0 - VGL(j,4) / (& L(3,j) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-1) & - )) > 1.d-14 ) return + )) > epsilon ) return end if + test_qmckl_ao_polynomial_vgl = -16 w = 0.d0 if (L(1,j) > 1) then w = w + L(1,j) * (L(1,j)-1) * Y(1)**(L(1,j)-2) * Y(2)**L(2,j) * Y(3)**L(3,j) @@ -458,7 +487,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) if (L(3,j) > 1) then w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2) end if - if (dabs(1.d0 - VGL(5,j) / w) > 1.d-14 ) return + if (dabs(1.d0 - VGL(j,5) / w) > epsilon ) return end do test_qmckl_ao_polynomial_vgl = 0 @@ -474,8 +503,220 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); #+END_SRC -* TODO Gaussian basis functions +* Gaussian basis functions + +** =qmckl_ao_gaussians_vgl= + + Computes the values, gradients and Laplacians at a given point of + =n= Gaussian functions centered at the same point: + + \[ v_i = exp(-a_i |X-R|^2) \] + \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] + \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] + \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] + \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] + +*** Arguments + + | =context= | input | Global state | + | =X(3)= | input | Array containing the coordinates of the points | + | =R(3)= | input | Array containing the x,y,z coordinates of the center | + | =n= | input | Number of computed gaussians | + | =A(n)= | input | Exponents of the Gaussians | + | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians | + | =ldv= | input | Leading dimension of array =VGL= | + +*** Requirements + + - =context= is not 0 + - =n= > 0 + - =ldv= >= 5 + - =A(i)= > 0 for all =i= + - =X= is allocated with at least $3 \times 8$ bytes + - =R= is allocated with at least $3 \times 8$ bytes + - =A= is allocated with at least $n \times 8$ bytes + - =VGL= is allocated with at least $n \times 5 \times 8$ bytes + +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +qmckl_exit_code qmckl_ao_gaussians_vgl(const qmckl_context context, + const double *X, const double *R, + const int64_t *n, const int64_t *A, + const double *VGL, const int64_t ldv); + #+END_SRC + +*** Source + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result(info) + implicit none + integer*8 , intent(in) :: context + real*8 , intent(in) :: X(3), R(3) + integer*8 , intent(in) :: n + real*8 , intent(in) :: A(n) + real*8 , intent(out) :: VGL(ldv,5) + integer*8 , intent(in) :: ldv + + integer*8 :: i,j + real*8 :: Y(3), r2, t, u, v + + info = 0 + + if (context == 0_8) then + info = -1 + return + endif + + if (n <= 0) then + info = -2 + return + endif + + if (ldv < n) then + info = -3 + return + endif + + + do i=1,3 + Y(i) = X(i) - R(i) + end do + r2 = Y(1)*Y(1) + Y(2)*Y(2) + Y(3)*Y(3) + + do i=1,n + VGL(i,1) = dexp(-A(i) * r2) + end do + + do i=1,n + VGL(i,5) = A(i) * VGL(i,1) + end do + + t = -2.d0 * ( X(1) - R(1) ) + u = -2.d0 * ( X(2) - R(2) ) + v = -2.d0 * ( X(3) - R(3) ) + + do i=1,n + VGL(i,2) = t * VGL(i,5) + VGL(i,3) = u * VGL(i,5) + VGL(i,4) = v * VGL(i,5) + end do + + t = 4.d0 * r2 + do i=1,n + VGL(i,5) = (t * A(i) - 6.d0) * VGL(i,5) + end do + +end function qmckl_ao_gaussians_vgl_f + #+END_SRC + +*** C interface :noexport: + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & + bind(C) result(info) + use, intrinsic :: iso_c_binding + implicit none + integer (c_int64_t) , intent(in) , value :: context + real (c_double) , intent(in) :: X(3), R(3) + integer (c_int64_t) , intent(in) , value :: n + real (c_double) , intent(in) :: A(n) + real (c_double) , intent(out) :: VGL(ldv,5) + integer (c_int64_t) , intent(in) , value :: ldv + + integer, external :: qmckl_ao_gaussians_vgl_f + info = qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) +end function qmckl_ao_gaussians_vgl + #+END_SRC + + #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh + interface + integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & + bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t) , intent(in) , value :: context + integer (c_int64_t) , intent(in) , value :: ldv + integer (c_int64_t) , intent(in) , value :: n + real (c_double) , intent(in) :: X(3), R(3), A(n) + real (c_double) , intent(out) :: VGL(ldv,5) + end function qmckl_ao_gaussians_vgl + end interface + #+END_SRC +*** Test :noexport: + #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 +integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) + use, intrinsic :: iso_c_binding + implicit none + include 'qmckl_context.fh' + include 'qmckl_ao.fh' + + integer(c_int64_t), intent(in), value :: context + + integer*8 :: n, ldv, j, i + double precision :: X(3), R(3), Y(3), r2 + double precision, allocatable :: VGL(:,:), A(:) + double precision :: epsilon + + epsilon = qmckl_context_get_epsilon(context) + + X = (/ 1.1 , 2.2 , 3.3 /) + R = (/ 0.1 , 1.2 , -2.3 /) + Y(:) = X(:) - R(:) + r2 = Y(1)**2 + Y(2)**2 + Y(3)**2 + + n = 10; + ldv = 100; + + allocate (A(n), VGL(ldv,5)) + do i=1,n + A(i) = 0.0013 * dble(ishft(1,i)) + end do + + + test_qmckl_ao_gaussians_vgl = & + qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) + if (test_qmckl_ao_gaussians_vgl /= 0) return + + test_qmckl_ao_gaussians_vgl = -1 + + do i=1,n + test_qmckl_ao_gaussians_vgl = -11 + if (dabs(1.d0 - VGL(i,1) / (& + dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussians_vgl = -12 + if (dabs(1.d0 - VGL(i,2) / (& + -2.d0 * A(i) * Y(1) * dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussians_vgl = -13 + if (dabs(1.d0 - VGL(i,3) / (& + -2.d0 * A(i) * Y(2) * dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussians_vgl = -14 + if (dabs(1.d0 - VGL(i,4) / (& + -2.d0 * A(i) * Y(3) * dexp(-A(i) * r2) & + )) > epsilon ) return + + test_qmckl_ao_gaussians_vgl = -15 + if (dabs(1.d0 - VGL(i,5) / (& + A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) & + )) > epsilon ) return + end do + + test_qmckl_ao_gaussians_vgl = 0 + + deallocate(VGL) +end function test_qmckl_ao_gaussians_vgl + #+END_SRC + + #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c +int test_qmckl_ao_gaussians_vgl(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_ao_gaussians_vgl(context)); + #+END_SRC + #+END_SRC + + * TODO Slater basis functions * End of files :noexport: diff --git a/src/qmckl_context.org b/src/qmckl_context.org index ad35918..635da3e 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -83,11 +83,11 @@ qmckl_context qmckl_context_check(const qmckl_context context) ; *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_check(const qmckl_context context) { - qmckl_context_struct * ctx; if (context == (qmckl_context) 0) return (qmckl_context) 0; - ctx = (qmckl_context_struct*) context; + const qmckl_context_struct * ctx = (qmckl_context_struct*) context; + if (ctx->tag != VALID_TAG) return (qmckl_context) 0; return context; @@ -109,9 +109,8 @@ qmckl_context qmckl_context_create(); #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_create() { - qmckl_context_struct* context; - - context = (qmckl_context_struct*) qmckl_malloc ((qmckl_context) 0, sizeof(qmckl_context_struct)); + qmckl_context_struct* context = + (qmckl_context_struct*) qmckl_malloc ((qmckl_context) 0, sizeof(qmckl_context_struct)); if (context == NULL) { return (qmckl_context) 0; } @@ -125,6 +124,15 @@ qmckl_context qmckl_context_create() { } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int64_t) function qmckl_context_create() bind(C) + use, intrinsic :: iso_c_binding + end function qmckl_context_create + end interface + #+END_SRC + *** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c context = qmckl_context_create(); @@ -149,23 +157,20 @@ qmckl_context qmckl_context_copy(const qmckl_context context); #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_copy(const qmckl_context context) { - qmckl_context_struct* old_context; - qmckl_context_struct* new_context; - qmckl_context checked_context; - - checked_context = qmckl_context_check(context); + const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) { return (qmckl_context) 0; } - new_context = (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); + qmckl_context_struct* old_context = (qmckl_context_struct*) checked_context; + + qmckl_context_struct* new_context = + (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); if (new_context == NULL) { return (qmckl_context) 0; } - old_context = (qmckl_context_struct*) checked_context; - new_context->prev = old_context; new_context->precision = old_context->precision; new_context->range = old_context->range; @@ -176,6 +181,16 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int64_t) function qmckl_context_copy(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_copy + end interface + #+END_SRC + *** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); @@ -200,19 +215,26 @@ qmckl_context qmckl_context_previous(const qmckl_context context); #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_previous(const qmckl_context context) { - qmckl_context checked_context; - qmckl_context_struct* ctx; - - checked_context = qmckl_context_check(context); + const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) { return (qmckl_context) 0; } - ctx = (qmckl_context_struct*) checked_context; + const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; return qmckl_context_check((qmckl_context) ctx->prev); } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int64_t) function qmckl_context_previous(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_previous + end interface + #+END_SRC + *** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); @@ -236,15 +258,12 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context); *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c -qmckl_exit_code qmckl_context_destroy(qmckl_context context) { +qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { - qmckl_context_struct* ctx; - qmckl_context checked_context; - - checked_context = qmckl_context_check(context); + const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) return QMCKL_FAILURE; - ctx = (qmckl_context_struct*) context; + qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; ctx->tag = INVALID_TAG; @@ -253,6 +272,16 @@ qmckl_exit_code qmckl_context_destroy(qmckl_context context) { } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int32_t) function qmckl_context_destroy(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_destroy + end interface + #+END_SRC + *** Test :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c munit_assert_int64(qmckl_context_check(new_context), ==, new_context); @@ -283,12 +312,11 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { - qmckl_context_struct* ctx; if (precision < 2) return QMCKL_FAILURE; if (precision > 53) return QMCKL_FAILURE; - ctx = (qmckl_context_struct*) context; + qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; ctx->precision = precision; @@ -296,6 +324,17 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: precision + end function qmckl_context_update_precision + end interface + #+END_SRC + *** TODO Tests :noexport: ** =qmckl_context_update_range= *** Header @@ -306,12 +345,11 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { - qmckl_context_struct* ctx; if (range < 2) return QMCKL_FAILURE; if (range > 11) return QMCKL_FAILURE; - ctx = (qmckl_context_struct*) context; + qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; ctx->range = range; @@ -319,6 +357,17 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: range + end function qmckl_context_update_range + end interface + #+END_SRC + *** TODO Tests :noexport: ** =qmckl_context_set_precision= *** Header @@ -329,9 +378,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { - qmckl_context new_context; - - new_context = qmckl_context_copy(context); + qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; if (qmckl_context_update_precision(context, precision) == QMCKL_FAILURE) return 0; @@ -340,6 +387,17 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int32_t) function qmckl_context_set_precision(context, precision) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: precision + end function qmckl_context_set_precision + end interface + #+END_SRC + *** TODO Tests :noexport: ** =qmckl_context_set_range= *** Header @@ -350,9 +408,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { - qmckl_context new_context; - - new_context = qmckl_context_copy(context); + qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; if (qmckl_context_update_range(context, range) == QMCKL_FAILURE) return 0; @@ -361,42 +417,97 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int32_t) function qmckl_context_set_range(context, range) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: range + end function qmckl_context_set_range + end interface + #+END_SRC + *** TODO Tests :noexport: ** =qmckl_context_get_precision= *** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h -int qmckl_context_get_precision(const qmckl_context context); +int32_t qmckl_context_get_precision(const qmckl_context context); #+END_SRC *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c int qmckl_context_get_precision(const qmckl_context context) { - qmckl_context_struct* ctx; - ctx = (qmckl_context_struct*) context; + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->precision; } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_precision + end interface + #+END_SRC + *** TODO Tests :noexport: ** =qmckl_context_get_range= *** Header #+BEGIN_SRC C :comments link :tangle qmckl_context.h -int qmckl_context_get_range(const qmckl_context context); +int32_t qmckl_context_get_range(const qmckl_context context); #+END_SRC *** Source #+BEGIN_SRC C :comments link :tangle qmckl_context.c int qmckl_context_get_range(const qmckl_context context) { - qmckl_context_struct* ctx; - ctx = (qmckl_context_struct*) context; + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->range; } #+END_SRC +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + integer (c_int32_t) function qmckl_context_get_range(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_range + end interface + #+END_SRC + +*** TODO Tests :noexport: + +** =qmckl_context_get_epsilon= + Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision +*** Header + #+BEGIN_SRC C :comments link :tangle qmckl_context.h +double qmckl_context_get_epsilon(const qmckl_context context); + #+END_SRC + +*** Source + #+BEGIN_SRC C :comments link :tangle qmckl_context.c +double qmckl_context_get_epsilon(const qmckl_context context) { + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + return 1.0 / ((double) ((int64_t) 1 << (ctx->precision-1))); +} + #+END_SRC + +*** Fortran interface + #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh + interface + real (c_double) function qmckl_context_get_epsilon(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_epsilon + end interface + #+END_SRC + *** TODO Tests :noexport: - * Info about the molecular system ** TODO =qmckl_context_set_nucl_coord= From e774a725b9e9eab16924da2a3ee2f6f4f96a8f77 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 12:57:39 +0100 Subject: [PATCH 45/61] Merging org files --- src/.gitignore | 1 + src/Makefile | 30 +++++++++++++++++------------- src/create_doc.sh | 26 ++++++++------------------ src/create_makefile.sh | 24 +++++++----------------- src/merge_org.sh | 12 ++++++++++++ src/qmckl.org | 34 ++++++++++++++++++++++++++++++++++ src/qmckl_ao.org | 12 +++--------- 7 files changed, 82 insertions(+), 57 deletions(-) create mode 100755 src/merge_org.sh diff --git a/src/.gitignore b/src/.gitignore index 0304f4e..aa0bfb8 100644 --- a/src/.gitignore +++ b/src/.gitignore @@ -8,3 +8,4 @@ *.so Makefile.generated test_qmckl +merged_qmckl.org diff --git a/src/Makefile b/src/Makefile index 66a009a..11aea2e 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,23 +1,24 @@ CC=gcc -g -CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra +CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra FC=gfortran -g FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan LIBS=-lgfortran -lm - -#CC=icc -#CFLAGS=-fPIC -g # -#FC=ifort -#FFLAGS=-fPIC -g +#CC=icc -xHost +#CFLAGS=-fPIC -g -O2 # -#LIBS=-lm -lifcore -lirc +#FC=ifort -xHost +#FFLAGS=-fPIC -g -O2 +# +#LIBS=-lm -lifcore -lirc export CC CFLAGS FC FFLAGS LIBS -ORG_SOURCE_FILES=$(wildcard qmckl*.org) test_qmckl.org +MERGED_ORG=merged_qmckl.org +ORG_SOURCE_FILES=$(wildcard *.org) OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES))) .PHONY: clean @@ -29,12 +30,15 @@ libqmckl.so: Makefile.generated test: Makefile.generated $(MAKE) -f Makefile.generated test -doc:$(ORG_SOURCE_FILES) - ./create_doc.sh README.org $(ORG_SOURCE_FILES) +$(MERGED_ORG): $(ORG_SOURCE_FILES) + ./merge_org.sh + +doc:$(MERGED_ORG) + ./create_doc.sh $(MERGED_ORG) clean: - rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh + rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod -Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh - ./create_makefile.sh $(ORG_SOURCE_FILES) +Makefile.generated: $(MERGED_ORG) Makefile create_makefile.sh + ./create_makefile.sh $(MERGED_ORG) diff --git a/src/create_doc.sh b/src/create_doc.sh index ab6ba4d..5613c26 100755 --- a/src/create_doc.sh +++ b/src/create_doc.sh @@ -1,23 +1,13 @@ #!/bin/bash +INPUT=$1 +#emacs merged_qmckl.org --batch --eval "(require 'htmlize)" -f org-html-export-to-html --kill +emacs \ + $INPUT \ + --batch \ + --eval "(package-initialize)" \ + -f org-html-export-to-html \ + --kill -# Tangle org files - -emacsclient -a "" \ - --socket-name=org_to_code \ - --eval "(load-file \"config.el\")" - -for INPUT in $@ ; do - echo $INPUT - emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval "(find-file \"$INPUT\")" \ - --eval "(org-html-export-to-html)" -done mv *.html ../docs -emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval '(kill-emacs)' diff --git a/src/create_makefile.sh b/src/create_makefile.sh index 60653d2..ee8168f 100755 --- a/src/create_makefile.sh +++ b/src/create_makefile.sh @@ -1,24 +1,14 @@ #!/bin/bash +INPUT=$1 OUTPUT=Makefile.generated # Tangle org files - -emacsclient -a "" \ - --socket-name=org_to_code \ - --eval "(require 'org)" - -for INPUT in $@ ; do - emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval "(org-babel-tangle-file \"$INPUT\")" -done - -emacsclient \ - --no-wait \ - --socket-name=org_to_code \ - --eval '(kill-emacs)' +emacs \ + $INPUT \ + --batch \ + -f org-babel-tangle \ + --kill @@ -68,7 +58,7 @@ libqmckl.so: \$(OBJECT_FILES) %.o: %.c \$(CC) \$(CFLAGS) -c \$*.c -o \$*.o -%.o: %.f90 +%.o: %.f90 qmckl_f.o \$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F) diff --git a/src/merge_org.sh b/src/merge_org.sh new file mode 100755 index 0000000..b6c227f --- /dev/null +++ b/src/merge_org.sh @@ -0,0 +1,12 @@ +#!/bin/bash + +for i in README.org \ + qmckl.org \ + qmckl_memory.org \ + qmckl_context.org \ + qmckl_distance.org \ + qmckl_ao.org \ + test_qmckl.org +do + cat $i >> merged_qmckl.org +done diff --git a/src/qmckl.org b/src/qmckl.org index c48e771..ca8f6cb 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -12,6 +12,8 @@ This file produces the =qmckl.h= header file, which is included in all other C header files. It is the main entry point to the library. +We also create the =qmckl_f.f90= which is the Fortran equivalent. + #+BEGIN_SRC C :tangle qmckl.h #ifndef QMCKL_H #define QMCKL_H @@ -19,6 +21,11 @@ other C header files. It is the main entry point to the library. #include #+END_SRC +#+BEGIN_SRC f90 :tangle qmckl_f.f90 +module qmckl + use, intrinsic :: iso_c_binding +#+END_SRC + * Constants ** Success/failure @@ -35,6 +42,10 @@ typedef int64_t qmckl_context ; #+END_SRC +#+BEGIN_SRC f90 :tangle qmckl_f.f90 +integer, parameter :: QMCKL_SUCCESS = 0 +integer, parameter :: QMCKL_FAILURE = 0 +#+END_SRC ** Precision-related constants @@ -47,6 +58,11 @@ typedef int64_t qmckl_context ; #define QMCKL_DEFAULT_RANGE 11 #+END_SRC +#+BEGIN_SRC f90 :tangle qmckl_f.f90 +integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 +integer, parameter :: QMCKL_DEFAULT_RANGE = 11 +#+END_SRC + * Header files All the functions expoed in the API are defined in the following @@ -61,6 +77,13 @@ typedef int64_t qmckl_context ; #include "qmckl_ao.h" #+END_SRC +#+BEGIN_SRC f90 :tangle qmckl_f.f90 +! include 'qmckl_memory.fh' +include 'qmckl_context.fh' +include 'qmckl_distance.fh' +include 'qmckl_ao.fh' +#+END_SRC + * End of header #+BEGIN_SRC C :tangle qmckl.h @@ -68,3 +91,14 @@ typedef int64_t qmckl_context ; #+END_SRC +#+BEGIN_SRC f90 :tangle qmckl_f.f90 +end module qmckl +#+END_SRC + + +* Include all other org files here :noexport: + +#+INCLUDE: qmckl_memory.org +#+INCLUDE: qmckl_context.org +#+INCLUDE: qmckl_distance.org +#+INCLUDE: qmckl_ao.org diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 5c39a62..d85b56c 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -160,10 +160,8 @@ end function qmckl_ao_powers *** Test :noexport: #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) - use, intrinsic :: iso_c_binding + use qmckl implicit none - include 'qmckl_context.fh' - include 'qmckl_ao.fh' integer(c_int64_t), intent(in), value :: context @@ -401,10 +399,8 @@ end function qmckl_ao_polynomial_vgl *** Test :noexport: #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) - use, intrinsic :: iso_c_binding + use qmckl implicit none - include 'qmckl_context.fh' - include 'qmckl_ao.fh' integer(c_int64_t), intent(in), value :: context @@ -643,10 +639,8 @@ end function qmckl_ao_gaussians_vgl *** Test :noexport: #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) - use, intrinsic :: iso_c_binding + use qmckl implicit none - include 'qmckl_context.fh' - include 'qmckl_ao.fh' integer(c_int64_t), intent(in), value :: context From ccc1b835d193df44db55b5e4068e87465ee42786 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 15:27:25 +0100 Subject: [PATCH 46/61] Simplify org-mode --- src/Makefile | 15 +- src/merge_org.sh | 1 + src/qmckl.org | 103 +++------ src/qmckl_ao.org | 331 ++++++++++++++-------------- src/qmckl_context.org | 475 ++++++++++++++++++++--------------------- src/qmckl_distance.org | 141 ++++++------ src/qmckl_footer.org | 13 ++ src/qmckl_memory.org | 122 ++++++----- 8 files changed, 555 insertions(+), 646 deletions(-) create mode 100644 src/qmckl_footer.org diff --git a/src/Makefile b/src/Makefile index 11aea2e..28de44e 100644 --- a/src/Makefile +++ b/src/Makefile @@ -5,7 +5,7 @@ FC=gfortran -g FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan LIBS=-lgfortran -lm -# + #CC=icc -xHost #CFLAGS=-fPIC -g -O2 # @@ -24,21 +24,24 @@ OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files -libqmckl.so: Makefile.generated +libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated test: Makefile.generated $(MAKE) -f Makefile.generated test -$(MERGED_ORG): $(ORG_SOURCE_FILES) - ./merge_org.sh -doc:$(MERGED_ORG) +doc: $(ORG_SOURCE_FILES) + ./merge_org.sh ./create_doc.sh $(MERGED_ORG) + rm $(MERGED_ORG) + clean: rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod -Makefile.generated: $(MERGED_ORG) Makefile create_makefile.sh +Makefile.generated: Makefile create_makefile.sh $(ORG_SOURCE_FILES) + ./merge_org.sh ./create_makefile.sh $(MERGED_ORG) + rm $(MERGED_ORG) diff --git a/src/merge_org.sh b/src/merge_org.sh index b6c227f..b4b2101 100755 --- a/src/merge_org.sh +++ b/src/merge_org.sh @@ -6,6 +6,7 @@ for i in README.org \ qmckl_context.org \ qmckl_distance.org \ qmckl_ao.org \ + qmckl_footer.org \ test_qmckl.org do cat $i >> merged_qmckl.org diff --git a/src/qmckl.org b/src/qmckl.org index ca8f6cb..ad77abd 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -1,104 +1,63 @@ -# -*- mode: org -*- -# vim: syntax=c -#+TITLE: QMCkl C header +* QMCKL header file -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: +This file produces the =qmckl.h= header file, which is to be included +when qmckl functions are used. -This file produces the =qmckl.h= header file, which is included in all -other C header files. It is the main entry point to the library. +We also create here the =qmckl_f.f90= which is the Fortran interface file. -We also create the =qmckl_f.f90= which is the Fortran equivalent. - -#+BEGIN_SRC C :tangle qmckl.h +** Top of header files :noexport: + + #+BEGIN_SRC C :tangle qmckl.h #ifndef QMCKL_H #define QMCKL_H #include #include -#+END_SRC + #+END_SRC -#+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 module qmckl use, intrinsic :: iso_c_binding -#+END_SRC + #+END_SRC -* Constants + The bottoms of the files are located in the [[qmckl_footer.org]] file. + +** Constants -** Success/failure +*** Success/failure - These are the codes returned by the functions to indicate success - or failure. All such functions should have as a return type =qmckl_exit_code=. + These are the codes returned by the functions to indicate success + or failure. All such functions should have as a return type =qmckl_exit_code=. - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle qmckl.h #define QMCKL_SUCCESS 0 #define QMCKL_FAILURE 1 typedef int32_t qmckl_exit_code; typedef int64_t qmckl_context ; - #+END_SRC + #+END_SRC -#+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 integer, parameter :: QMCKL_SUCCESS = 0 integer, parameter :: QMCKL_FAILURE = 0 -#+END_SRC + #+END_SRC -** Precision-related constants +*** Precision-related constants - Controlling numerical precision enables optimizations. Here, the - default parameters determining the target numerical precision and - range are defined. + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle qmckl.h #define QMCKL_DEFAULT_PRECISION 53 #define QMCKL_DEFAULT_RANGE 11 - #+END_SRC + #+END_SRC -#+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 integer, parameter :: QMCKL_DEFAULT_RANGE = 11 -#+END_SRC + #+END_SRC + -* Header files - - All the functions expoed in the API are defined in the following - header files. - - #+BEGIN_SRC C :tangle qmckl.h - -#include "qmckl_memory.h" -#include "qmckl_context.h" - -#include "qmckl_distance.h" -#include "qmckl_ao.h" - #+END_SRC - -#+BEGIN_SRC f90 :tangle qmckl_f.f90 -! include 'qmckl_memory.fh' -include 'qmckl_context.fh' -include 'qmckl_distance.fh' -include 'qmckl_ao.fh' -#+END_SRC - -* End of header - -#+BEGIN_SRC C :tangle qmckl.h -#endif -#+END_SRC - - -#+BEGIN_SRC f90 :tangle qmckl_f.f90 -end module qmckl -#+END_SRC - - -* Include all other org files here :noexport: - -#+INCLUDE: qmckl_memory.org -#+INCLUDE: qmckl_context.org -#+INCLUDE: qmckl_distance.org -#+INCLUDE: qmckl_ao.org + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index d85b56c..bcd46ed 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -1,97 +1,79 @@ -# -*- mode: org -*- -# vim: syntax=c -#+TITLE: Atomic Orbitals +* Atomic Orbitals -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: This files contains all the routines for the computation of the values, gradients and Laplacian of the atomic basis functions. -4 files are produced: -- a header file : =qmckl_ao.h= +3 files are produced: - a source file : =qmckl_ao.f90= - a C test file : =test_qmckl_ao.c= - a Fortran test file : =test_qmckl_ao_f.f90= -*** Header :noexport: - #+BEGIN_SRC C :comments link :tangle qmckl_ao.h -#ifndef QMCKL_AO_H -#define QMCKL_AO_H -#include "qmckl_context.h" -#include "qmckl_distance.h" - #+END_SRC - -*** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c +** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_ao.c #include #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_ao() { qmckl_context context; context = qmckl_context_create(); - #+END_SRC + #+END_SRC +** Polynomials -* Polynomials + \[ + P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c + \] + \begin{eqnarray*} + \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ + \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ + \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ + \end{eqnarray*} + \begin{eqnarray*} + \left( \frac{\partial }{\partial x^2} + + \frac{\partial }{\partial y^2} + + \frac{\partial }{\partial z^2} \right) P_l + \left(\mathbf{r},\mathbf{R}_i \right) & = & + a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ + && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ + && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} + \end{eqnarray*} - \[ - P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c - \] - \begin{eqnarray*} - \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ - \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ - \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ - \end{eqnarray*} - \begin{eqnarray*} - \left( \frac{\partial }{\partial x^2} + - \frac{\partial }{\partial y^2} + - \frac{\partial }{\partial z^2} \right) P_l - \left(\mathbf{r},\mathbf{R}_i \right) & = & - a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ - && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ - && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} - \end{eqnarray*} +*** =qmckl_ao_powers= -** =qmckl_ao_powers= - - Computes all the powers of the =n= input data up to the given - maximum value given in input for each of the $n$ points: + Computes all the powers of the =n= input data up to the given + maximum value given in input for each of the $n$ points: - \[ P_{ij} = X_j^i \] + \[ P_{ij} = X_j^i \] -*** Arguments +**** Arguments - | =context= | input | Global state | - | =n= | input | Number of values | - | =X(n)= | input | Array containing the input values | - | =LMAX(n)= | input | Array containing the maximum power for each value | - | =P(LDP,n)= | output | Array containing all the powers of =X= | - | =LDP= | input | Leading dimension of array =P= | + | =context= | input | Global state | + | =n= | input | Number of values | + | =X(n)= | input | Array containing the input values | + | =LMAX(n)= | input | Array containing the maximum power for each value | + | =P(LDP,n)= | output | Array containing all the powers of =X= | + | =LDP= | input | Leading dimension of array =P= | -*** Requirements +**** Requirements - - =context= is not 0 - - =n= > 0 - - =X= is allocated with at least $n \times 8$ bytes - - =LMAX= is allocated with at least $n \times 4$ bytes - - =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - - =LDP= >= $\max_i$ =LMAX[i]= + - =context= is not 0 + - =n= > 0 + - =X= is allocated with at least $n \times 8$ bytes + - =LMAX= is allocated with at least $n \times 4$ bytes + - =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - =LDP= >= $\max_i$ =LMAX[i]= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +**** Header + #+BEGIN_SRC C :tangle qmckl.h qmckl_exit_code qmckl_ao_powers(const qmckl_context context, const int64_t n, const double *X, const int32_t *LMAX, const double *P, const int64_t LDP); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +**** Source + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) implicit none integer*8 , intent(in) :: context @@ -123,10 +105,10 @@ integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) end do end function qmckl_ao_powers_f - #+END_SRC + #+END_SRC -*** C interface :noexport: - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +**** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -141,9 +123,9 @@ integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & integer, external :: qmckl_ao_powers_f info = qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) end function qmckl_ao_powers - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) bind(C) use, intrinsic :: iso_c_binding @@ -155,10 +137,10 @@ end function qmckl_ao_powers real (c_double) , intent(out) :: P(ldp,n) end function qmckl_ao_powers end interface - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 +**** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) use qmckl implicit none @@ -201,55 +183,55 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) test_qmckl_ao_powers = 0 deallocate(X,P,LMAX) end function test_qmckl_ao_powers - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle test_qmckl_ao.c int test_qmckl_ao_powers(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_powers(context)); - #+END_SRC + #+END_SRC -** =qmckl_ao_polynomial_vgl= +*** =qmckl_ao_polynomial_vgl= - Computes the values, gradients and Laplacians at a given point of - all polynomials with an angular momentum up to =lmax=. + Computes the values, gradients and Laplacians at a given point of + all polynomials with an angular momentum up to =lmax=. -*** Arguments +**** Arguments - | =context= | input | Global state | - | =X(3)= | input | Array containing the coordinates of the points | - | =R(3)= | input | Array containing the x,y,z coordinates of the center | - | =lmax= | input | Maximum angular momentum | - | =n= | output | Number of computed polynomials | - | =L(ldl,n)= | output | Contains a,b,c for all =n= results | - | =ldl= | input | Leading dimension of =L= | - | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials | - | =ldv= | input | Leading dimension of array =VGL= | + | =context= | input | Global state | + | =X(3)= | input | Array containing the coordinates of the points | + | =R(3)= | input | Array containing the x,y,z coordinates of the center | + | =lmax= | input | Maximum angular momentum | + | =n= | output | Number of computed polynomials | + | =L(ldl,n)= | output | Contains a,b,c for all =n= results | + | =ldl= | input | Leading dimension of =L= | + | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials | + | =ldv= | input | Leading dimension of array =VGL= | -*** Requirements +**** Requirements - - =context= is not 0 - - =n= > 0 - - =lmax= >= 0 - - =ldl= >= 3 - - =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 - - =X= is allocated with at least $3 \times 8$ bytes - - =R= is allocated with at least $3 \times 8$ bytes - - =L= is allocated with at least $3 \times n \times 4$ bytes - - =VGL= is allocated with at least $n \times 5 \times 8$ bytes - - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 + - =context= is not 0 + - =n= > 0 + - =lmax= >= 0 + - =ldl= >= 3 + - =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 + - =X= is allocated with at least $3 \times 8$ bytes + - =R= is allocated with at least $3 \times 8$ bytes + - =L= is allocated with at least $3 \times n \times 4$ bytes + - =VGL= is allocated with at least $n \times 5 \times 8$ bytes + - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +**** Header + #+BEGIN_SRC C :tangle qmckl.h qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, const double *X, const double *R, const int32_t lmax, const int64_t *n, const int32_t *L, const int64_t ldl, const double *VGL, const int64_t ldv); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +**** Source + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -358,10 +340,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, info = 0 end function qmckl_ao_polynomial_vgl_f - #+END_SRC + #+END_SRC -*** C interface :noexport: - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +**** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -378,9 +360,9 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l integer, external :: qmckl_ao_polynomial_vgl_f info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) end function qmckl_ao_polynomial_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) @@ -395,9 +377,9 @@ end function qmckl_ao_polynomial_vgl real (c_double) , intent(out) :: VGL(ldv,5) end function qmckl_ao_polynomial_vgl end interface - #+END_SRC -*** Test :noexport: - #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 + #+END_SRC +**** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl implicit none @@ -490,60 +472,58 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) deallocate(L,VGL) end function test_qmckl_ao_polynomial_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle test_qmckl_ao.c int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - #+END_SRC - #+END_SRC + #+END_SRC + #+END_SRC +** Gaussian basis functions + +*** =qmckl_ao_gaussians_vgl= + + Computes the values, gradients and Laplacians at a given point of + =n= Gaussian functions centered at the same point: + + \[ v_i = exp(-a_i |X-R|^2) \] + \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] + \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] + \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] + \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] + +**** Arguments + + | =context= | input | Global state | + | =X(3)= | input | Array containing the coordinates of the points | + | =R(3)= | input | Array containing the x,y,z coordinates of the center | + | =n= | input | Number of computed gaussians | + | =A(n)= | input | Exponents of the Gaussians | + | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians | + | =ldv= | input | Leading dimension of array =VGL= | -* Gaussian basis functions +**** Requirements + - =context= is not 0 + - =n= > 0 + - =ldv= >= 5 + - =A(i)= > 0 for all =i= + - =X= is allocated with at least $3 \times 8$ bytes + - =R= is allocated with at least $3 \times 8$ bytes + - =A= is allocated with at least $n \times 8$ bytes + - =VGL= is allocated with at least $n \times 5 \times 8$ bytes -** =qmckl_ao_gaussians_vgl= - - Computes the values, gradients and Laplacians at a given point of - =n= Gaussian functions centered at the same point: - - \[ v_i = exp(-a_i |X-R|^2) \] - \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] - \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] - \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] - \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] - -*** Arguments - - | =context= | input | Global state | - | =X(3)= | input | Array containing the coordinates of the points | - | =R(3)= | input | Array containing the x,y,z coordinates of the center | - | =n= | input | Number of computed gaussians | - | =A(n)= | input | Exponents of the Gaussians | - | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians | - | =ldv= | input | Leading dimension of array =VGL= | - -*** Requirements - - - =context= is not 0 - - =n= > 0 - - =ldv= >= 5 - - =A(i)= > 0 for all =i= - - =X= is allocated with at least $3 \times 8$ bytes - - =R= is allocated with at least $3 \times 8$ bytes - - =A= is allocated with at least $n \times 8$ bytes - - =VGL= is allocated with at least $n \times 5 \times 8$ bytes - -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_ao.h +**** Header + #+BEGIN_SRC C :tangle qmckl.h qmckl_exit_code qmckl_ao_gaussians_vgl(const qmckl_context context, const double *X, const double *R, const int64_t *n, const int64_t *A, const double *VGL, const int64_t ldv); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +**** Source + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -603,10 +583,10 @@ integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result( end do end function qmckl_ao_gaussians_vgl_f - #+END_SRC + #+END_SRC -*** C interface :noexport: - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 +**** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -621,9 +601,9 @@ integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv integer, external :: qmckl_ao_gaussians_vgl_f info = qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) end function qmckl_ao_gaussians_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & bind(C) @@ -635,9 +615,9 @@ end function qmckl_ao_gaussians_vgl real (c_double) , intent(out) :: VGL(ldv,5) end function qmckl_ao_gaussians_vgl end interface - #+END_SRC -*** Test :noexport: - #+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 + #+END_SRC +**** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) use qmckl implicit none @@ -702,29 +682,28 @@ integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) deallocate(VGL) end function test_qmckl_ao_gaussians_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle test_qmckl_ao.c int test_qmckl_ao_gaussians_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_gaussians_vgl(context)); - #+END_SRC - #+END_SRC + #+END_SRC + #+END_SRC -* TODO Slater basis functions +** TODO Slater basis functions -* End of files :noexport: +** End of files :noexport: -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_ao.h -#endif - #+END_SRC - -*** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c +**** Test + #+BEGIN_SRC C :tangle test_qmckl_ao.c if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return MUNIT_OK; } - #+END_SRC + #+END_SRC + + + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 635da3e..dc1eeca 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,53 +1,41 @@ -# -*- mode: org -*- -# vim: syntax=c -#+TITLE: Context +* Context -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: + This file is written in C because it is more natural to express the context in + C than in Fortran. + 2 files are produced: + - a source file : =qmckl_context.c= + - a test file : =test_qmckl_context.c= -This file is written in C because it is more natural to express the context in -C than in Fortran. - -3 files are produced: -- a header file : =qmckl_context.h= -- a source file : =qmckl_context.c= -- a test file : =test_qmckl_context.c= - -*** Header :noexport: - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -#ifndef QMCKL_CONTEXT_H -#define QMCKL_CONTEXT_H +** Headers :noexport: + #+BEGIN_SRC C :tangle qmckl_context.c #include "qmckl.h" - #+END_SRC + #+END_SRC -*** Source :noexport: - #+BEGIN_SRC C :comments link :tangle qmckl_context.c -#include "qmckl.h" - #+END_SRC - -*** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c + #+BEGIN_SRC C :tangle test_qmckl_context.c #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_context() { - #+END_SRC + #+END_SRC -* Context +** Context - The context variable is a handle for the state of the library, and - is stored in the following data structure, which can't be seen - outside of the library. To simplify compatibility with other - languages, the pointer to the internal data structure is converted - into a 64-bit signed integer, defined in the =qmckl_context= type. - A value of 0 for the context is equivalent to a =NULL= pointer. + The context variable is a handle for the state of the library, and + is stored in the following data structure, which can't be seen + outside of the library. To simplify compatibility with other + languages, the pointer to the internal data structure is converted + into a 64-bit signed integer, defined in the =qmckl_context= type. + A value of 0 for the context is equivalent to a =NULL= pointer. -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c + #+BEGIN_SRC C :comments org :tangle qmckl.h + #+END_SRC + +**** Source + + The tag is used internally to check if the memory domain pointed by + a pointer is a valid context. + + #+BEGIN_SRC C :comments org :tangle qmckl_context.c typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; uint32_t tag; @@ -57,31 +45,26 @@ typedef struct qmckl_context_struct { #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF - #+END_SRC + #+END_SRC - The tag is used internally to check if the memory domain pointed by - a pointer is a valid context. - -*** Test :noexport: - We declare here the variables used in the tests. - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - qmckl_context context; - qmckl_context new_context; - #+END_SRC +**** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_context.c +qmckl_context context; +qmckl_context new_context; + #+END_SRC -** =qmckl_context_check= +*** =qmckl_context_check= - Checks if the domain pointed by the pointer is a valid context. - Returns the input =qmckl_context= if the context is valid, 0 otherwise. + Checks if the domain pointed by the pointer is a valid context. + Returns the input =qmckl_context= if the context is valid, 0 otherwise. -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_check(const qmckl_context context) ; #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_check(const qmckl_context context) { if (context == (qmckl_context) 0) return (qmckl_context) 0; @@ -92,21 +75,20 @@ qmckl_context qmckl_context_check(const qmckl_context context) { return context; } - #+END_SRC + #+END_SRC -** =qmckl_context_create= +*** =qmckl_context_create= - To create a new context, use =qmckl_context_create()=. - - On success, returns a pointer to a context using the =qmckl_context= type - - Returns 0 upon failure to allocate the internal data structure + To create a new context, use =qmckl_context_create()=. + - On success, returns a pointer to a context using the =qmckl_context= type + - Returns 0 upon failure to allocate the internal data structure -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_create(); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_create() { qmckl_context_struct* context = @@ -122,39 +104,38 @@ qmckl_context qmckl_context_create() { return (qmckl_context) context; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int64_t) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding end function qmckl_context_create end interface - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - context = qmckl_context_create(); - munit_assert_int64( context, !=, (qmckl_context) 0); - munit_assert_int64( qmckl_context_check(context), ==, context); - #+END_SRC +**** Test :noexport: + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +context = qmckl_context_create(); +munit_assert_int64( context, !=, (qmckl_context) 0); +munit_assert_int64( qmckl_context_check(context), ==, context); + #+END_SRC -** =qmckl_context_copy= +*** =qmckl_context_copy= - This function makes a shallow copy of the current context. - - Copying the 0-valued context returns 0 - - On success, returns a pointer to the new context using the =qmckl_context= type - - Returns 0 upon failure to allocate the internal data structure - for the new context + This function makes a shallow copy of the current context. + - Copying the 0-valued context returns 0 + - On success, returns a pointer to the new context using the =qmckl_context= type + - Returns 0 upon failure to allocate the internal data structure + for the new context -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_copy(const qmckl_context context); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_copy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -179,40 +160,39 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { return (qmckl_context) new_context; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int64_t) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_copy end interface - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - new_context = qmckl_context_copy(context); - munit_assert_int64(new_context, !=, (qmckl_context) 0); - munit_assert_int64(new_context, !=, context); - munit_assert_int64(qmckl_context_check(new_context), ==, new_context); - #+END_SRC +**** Test :noexport: + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +new_context = qmckl_context_copy(context); +munit_assert_int64(new_context, !=, (qmckl_context) 0); +munit_assert_int64(new_context, !=, context); +munit_assert_int64(qmckl_context_check(new_context), ==, new_context); + #+END_SRC -** =qmckl_context_previous= +*** =qmckl_context_previous= - Returns the previous context - - On success, returns the ancestor of the current context - - Returns 0 for the initial context - - Returns 0 for the 0-valued context + Returns the previous context + - On success, returns the ancestor of the current context + - Returns 0 for the initial context + - Returns 0 for the 0-valued context -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_previous(const qmckl_context context); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -223,41 +203,40 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; return qmckl_context_check((qmckl_context) ctx->prev); } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int64_t) function qmckl_context_previous(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_previous end interface - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); - munit_assert_int64(qmckl_context_previous(new_context), ==, context); - munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); - munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); - #+END_SRC +**** Test :noexport: + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); +munit_assert_int64(qmckl_context_previous(new_context), ==, context); +munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); +munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); + #+END_SRC -** =qmckl_context_destroy= +*** =qmckl_context_destroy= - Destroys the current context, leaving the ancestors untouched. - - Succeeds if the current context is properly destroyed - - Fails otherwise - - Fails if the 0-valued context is given in argument - - Fails if the the pointer is not a valid context + Destroys the current context, leaving the ancestors untouched. + - Succeeds if the current context is properly destroyed + - Fails otherwise + - Fails if the 0-valued context is given in argument + - Fails if the the pointer is not a valid context -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_context_destroy(qmckl_context context); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -270,47 +249,47 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { qmckl_free(ctx); return QMCKL_SUCCESS; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_destroy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_destroy end interface - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - munit_assert_int64(qmckl_context_check(new_context), ==, new_context); - munit_assert_int64(new_context, !=, (qmckl_context) 0); - munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); - munit_assert_int64(qmckl_context_check(new_context), !=, new_context); - munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); - munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); - #+END_SRC +**** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_context.c +munit_assert_int64(qmckl_context_check(new_context), ==, new_context); +munit_assert_int64(new_context, !=, (qmckl_context) 0); +munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); +munit_assert_int64(qmckl_context_check(new_context), !=, new_context); +munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); +munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); + #+END_SRC -* Precision +** Precision - The following functions set and get the expected required precision - and range. =precision= should be an integer between 2 and 53, and - =range= should be an integer between 2 and 11. + The following functions set and get the expected required precision + and range. =precision= should be an integer between 2 and 53, and + =range= should be an integer between 2 and 11. - The setter functions functions return a new context as a 64-bit integer. - The getter functions return the value, as a 32-bit integer. - The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. + The setter functions functions return a new context as a 64-bit integer. + The getter functions return the value, as a 32-bit integer. + The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. -** =qmckl_context_update_precision= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h +*** =qmckl_context_update_precision= + Modifies the parameter for the numerical precision in a given context. + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { if (precision < 2) return QMCKL_FAILURE; @@ -322,10 +301,10 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons ctx->precision = precision; return QMCKL_SUCCESS; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -333,17 +312,17 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons integer (c_int32_t), intent(in), value :: precision end function qmckl_context_update_precision end interface - #+END_SRC + #+END_SRC -*** TODO Tests :noexport: -** =qmckl_context_update_range= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h +**** TODO Tests :noexport: +*** =qmckl_context_update_range= + Modifies the parameter for the numerical range in a given context. + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { if (range < 2) return QMCKL_FAILURE; @@ -355,10 +334,10 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in ctx->range = range; return QMCKL_SUCCESS; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -366,17 +345,17 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in integer (c_int32_t), intent(in), value :: range end function qmckl_context_update_range end interface + #+END_SRC + +**** TODO Tests :noexport: +*** =qmckl_context_set_precision= + Returns a copy of the context with a different precision parameter. + #+BEGIN_SRC C :comments or :tangle qmckl.h +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC -*** TODO Tests :noexport: -** =qmckl_context_set_precision= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); - #+END_SRC - -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -385,10 +364,10 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int return new_context; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_set_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -396,17 +375,17 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int integer (c_int32_t), intent(in), value :: precision end function qmckl_context_set_precision end interface + #+END_SRC + +**** TODO Tests :noexport: +*** =qmckl_context_set_range= + Returns a copy of the context with a different precision parameter. + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC -*** TODO Tests :noexport: -** =qmckl_context_set_range= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); - #+END_SRC - -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -415,10 +394,10 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran return new_context; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_set_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -426,104 +405,102 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran integer (c_int32_t), intent(in), value :: range end function qmckl_context_set_range end interface + #+END_SRC + +**** TODO Tests :noexport: + +*** =qmckl_context_get_precision= + Returns the value of the numerical precision in the context + #+BEGIN_SRC C :comments org :tangle qmckl.h +int32_t qmckl_context_get_precision(const qmckl_context context); #+END_SRC -*** TODO Tests :noexport: - -** =qmckl_context_get_precision= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -int32_t qmckl_context_get_precision(const qmckl_context context); - #+END_SRC - -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c int qmckl_context_get_precision(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->precision; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_precision end interface + #+END_SRC + +**** TODO Tests :noexport: +*** =qmckl_context_get_range= + Returns the value of the numerical range in the context + #+BEGIN_SRC C :comments org :tangle qmckl.h +int32_t qmckl_context_get_range(const qmckl_context context); #+END_SRC -*** TODO Tests :noexport: -** =qmckl_context_get_range= -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -int32_t qmckl_context_get_range(const qmckl_context context); - #+END_SRC - -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c int qmckl_context_get_range(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->range; } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_get_range(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_range end interface + #+END_SRC + +**** TODO Tests :noexport: + +*** =qmckl_context_get_epsilon= + Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision + #+BEGIN_SRC C :comments org :tangle qmckl.h +double qmckl_context_get_epsilon(const qmckl_context context); #+END_SRC -*** TODO Tests :noexport: - -** =qmckl_context_get_epsilon= - Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -double qmckl_context_get_epsilon(const qmckl_context context); - #+END_SRC - -*** Source - #+BEGIN_SRC C :comments link :tangle qmckl_context.c +**** Source + #+BEGIN_SRC C :tangle qmckl_context.c double qmckl_context_get_epsilon(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return 1.0 / ((double) ((int64_t) 1 << (ctx->precision-1))); } - #+END_SRC + #+END_SRC -*** Fortran interface - #+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh +**** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface real (c_double) function qmckl_context_get_epsilon(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_epsilon end interface - #+END_SRC + #+END_SRC -*** TODO Tests :noexport: +**** TODO Tests :noexport: -* Info about the molecular system +** Info about the molecular system -** TODO =qmckl_context_set_nucl_coord= -** TODO =qmckl_context_set_nucl_charge= -** TODO =qmckl_context_set_elec_num= +*** TODO =qmckl_context_set_nucl_coord= +*** TODO =qmckl_context_set_nucl_charge= +*** TODO =qmckl_context_set_elec_num= -* End of files :noexport: +** End of files :noexport: -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_context.h -#endif - #+END_SRC - -*** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c - return MUNIT_OK; +**** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +return MUNIT_OK; } - #+END_SRC + #+END_SRC + + +# -*- mode: org -*- +# vim: syntax=c diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 847ca30..f50361d 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -1,30 +1,13 @@ -# -*- mode: org -*- -# vim: syntax=c -#+TITLE: Computation of distances - -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: +* Computation of distances Function for the computation of distances between particles. -4 files are produced: -- a header file : =qmckl_distance.h= +3 files are produced: - a source file : =qmckl_distance.f90= - a C test file : =test_qmckl_distance.c= - a Fortran test file : =test_qmckl_distance_f.f90= -*** Header :noexport: - #+BEGIN_SRC C :comments link :tangle qmckl_distance.h -#ifndef QMCKL_DISTANCE_H -#define QMCKL_DISTANCE_H -#include "qmckl_context.h" - #+END_SRC - -*** Test :noexport: +*** Headers :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c #include #include "qmckl.h" @@ -36,61 +19,60 @@ MunitResult test_qmckl_distance() { #+END_SRC -* Squared distance +** Squared distance -** =qmckl_distance_sq= +*** =qmckl_distance_sq= - Computes the matrix of the squared distances between all pairs of - points in two sets, one point within each set: - \[ - C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 - \] + Computes the matrix of the squared distances between all pairs of + points in two sets, one point within each set: + \[ + C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 + \] -*** Arguments +**** Arguments - | =context= | input | Global state | - | =transa= | input | Array =A= is =N=: Normal, =T=: Transposed | - | =transb= | input | Array =B= is =N=: Normal, =T=: Transposed | - | =m= | input | Number of points in the first set | - | =n= | input | Number of points in the second set | - | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | - | =lda= | input | Leading dimension of array =A= | - | =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ | - | =ldb= | input | Leading dimension of array =B= | - | =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ | - | =ldc= | input | Leading dimension of array =C= | + | =context= | input | Global state | + | =transa= | input | Array =A= is =N=: Normal, =T=: Transposed | + | =transb= | input | Array =B= is =N=: Normal, =T=: Transposed | + | =m= | input | Number of points in the first set | + | =n= | input | Number of points in the second set | + | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | + | =lda= | input | Leading dimension of array =A= | + | =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ | + | =ldb= | input | Leading dimension of array =B= | + | =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ | + | =ldc= | input | Leading dimension of array =C= | -*** Requirements +**** Requirements - - =context= is not 0 - - =m= > 0 - - =n= > 0 - - =lda= >= 3 if =transa= is =N= - - =lda= >= m if =transa= is =T= - - =ldb= >= 3 if =transb= is =N= - - =ldb= >= n if =transb= is =T= - - =ldc= >= m if =transa= is = - - =A= is allocated with at least $3 \times m \times 8$ bytes - - =B= is allocated with at least $3 \times n \times 8$ bytes - - =C= is allocated with at least $m \times n \times 8$ bytes + - =context= is not 0 + - =m= > 0 + - =n= > 0 + - =lda= >= 3 if =transa= is =N= + - =lda= >= m if =transa= is =T= + - =ldb= >= 3 if =transb= is =N= + - =ldb= >= n if =transb= is =T= + - =ldc= >= m if =transa= is = + - =A= is allocated with at least $3 \times m \times 8$ bytes + - =B= is allocated with at least $3 \times n \times 8$ bytes + - =C= is allocated with at least $m \times n \times 8$ bytes -*** Performance +**** Performance - This function might be more efficient when =A= and =B= are - transposed. + This function might be more efficient when =A= and =B= are + transposed. -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_distance.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_distance_sq(const qmckl_context context, const char transa, const char transb, const int64_t m, const int64_t n, const double *A, const int64_t lda, const double *B, const int64_t ldb, const double *C, const int64_t ldc); - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 +**** Source + #+BEGIN_SRC f90 :tangle qmckl_distance.f90 integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) implicit none integer*8 , intent(in) :: context @@ -215,10 +197,10 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L end select end function qmckl_distance_sq_f - #+END_SRC + #+END_SRC -*** C interface :noexport: - #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 +**** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_distance.f90 integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -236,9 +218,9 @@ integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, integer, external :: qmckl_distance_sq_f info = qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) end function qmckl_distance_sq - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :comments link :tangle qmckl_distance.fh + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) @@ -255,14 +237,13 @@ end function qmckl_distance_sq real (c_double) , intent(out) :: C(ldc,n) end function qmckl_distance_sq end interface - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC f90 :comments link :tangle test_qmckl_distance_f.f90 +**** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_distance_f.f90 integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) - use, intrinsic :: iso_c_binding + use qmckl implicit none - include 'qmckl_distance.fh' integer(c_int64_t), intent(in), value :: context double precision, allocatable :: A(:,:), B(:,:), C(:,:) @@ -355,24 +336,22 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) deallocate(A,B,C) end function test_qmckl_distance_sq - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c int test_qmckl_distance_sq(qmckl_context context); munit_assert_int(0, ==, test_qmckl_distance_sq(context)); - #+END_SRC -* End of files :noexport: + #+END_SRC +** End of files :noexport: -*** Header - #+BEGIN_SRC C :comments link :tangle qmckl_distance.h -#endif - #+END_SRC - -*** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return MUNIT_OK; } - #+END_SRC + #+END_SRC + + +# -*- mode: org -*- +# vim: syntax=c diff --git a/src/qmckl_footer.org b/src/qmckl_footer.org new file mode 100644 index 0000000..53fab1b --- /dev/null +++ b/src/qmckl_footer.org @@ -0,0 +1,13 @@ +* End of header files :noexport: + +#+BEGIN_SRC C :tangle qmckl.h +#endif +#+END_SRC + +#+BEGIN_SRC f90 :tangle qmckl_f.f90 +end module qmckl +#+END_SRC + + +# -*- mode: org -*- + diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index b6326b2..cf16b9e 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -1,52 +1,44 @@ -# -*- mode: org -*- -# vim: syntax=c -#+TITLE: Memory management - -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: - +* Memory management We override the allocation functions to enable the possibility of optimized libraries to fine-tune the memory allocation. -3 files are produced: -- a header file : =qmckl_memory.h= +2 files are produced: - a source file : =qmckl_memory.c= - a test file : =test_qmckl_memory.c= -** Header :noexport: - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h -#ifndef QMCKL_MEMORY_H -#define QMCKL_MEMORY_H +** Headers :noexport: + #+BEGIN_SRC C :tangle qmckl_memory.c #include "qmckl.h" #+END_SRC -** Source :noexport: - #+BEGIN_SRC C :comments link :tangle qmckl_memory.c -#include -#include "qmckl_memory.h" - #+END_SRC - -** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c + #+BEGIN_SRC C :tangle test_qmckl_memory.c #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_memory() { #+END_SRC -* =qmckl_malloc= - Analogous of =malloc, but passing a context and a signed 64-bit integers as argument.= -** Header - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h +** =qmckl_malloc= + + Memory allocation function, letting the library choose how the + memory will be allocated, and a pointer is returned to the user. + + #+BEGIN_SRC C :tangle qmckl.h void* qmckl_malloc(const qmckl_context ctx, const size_t size); #+END_SRC -** Source - #+BEGIN_SRC C :comments link :tangle qmckl_memory.c + #+BEGIN_SRC f90 :tangle qmckl_f.f90 + interface + type (c_ptr) function qmckl_malloc (context, size) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int64_t), intent(in), value :: size + end function qmckl_malloc + end interface + #+END_SRC + +*** Source + #+BEGIN_SRC C :tangle qmckl_memory.c void* qmckl_malloc(const qmckl_context ctx, const size_t size) { if (ctx == (qmckl_context) 0) { /* Avoids unused parameter error */ @@ -55,49 +47,55 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size) { return malloc( (size_t) size ); } - #+END_SRC + #+END_SRC -** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c - int *a; - a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); - a[0] = 1; - a[1] = 2; - a[2] = 3; - munit_assert_int(a[0], ==, 1); - munit_assert_int(a[1], ==, 2); - munit_assert_int(a[2], ==, 3); - #+END_SRC +*** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_memory.c +int *a; +a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); +a[0] = 1; +a[1] = 2; +a[2] = 3; +munit_assert_int(a[0], ==, 1); +munit_assert_int(a[1], ==, 2); +munit_assert_int(a[2], ==, 3); + #+END_SRC -* =qmckl_free= +** =qmckl_free= -** Header - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h + #+BEGIN_SRC C :tangle qmckl.h void qmckl_free(void *ptr); #+END_SRC -** Source - #+BEGIN_SRC C :comments link :tangle qmckl_memory.c + #+BEGIN_SRC f90 :tangle qmckl_f.f90 + interface + subroutine qmckl_free (ptr) bind(C) + use, intrinsic :: iso_c_binding + type (c_ptr), intent(in), value :: ptr + end subroutine qmckl_free + end interface + #+END_SRC +*** Source + #+BEGIN_SRC C :tangle qmckl_memory.c void qmckl_free(void *ptr) { free(ptr); } - #+END_SRC + #+END_SRC -** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c - qmckl_free(a); - #+END_SRC +*** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_memory.c +qmckl_free(a); + #+END_SRC -* End of files :noexport: +** End of files :noexport: -** Header - #+BEGIN_SRC C :comments link :tangle qmckl_memory.h -#endif - #+END_SRC - -** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c +*** Test + #+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c return MUNIT_OK; } - #+END_SRC + #+END_SRC + + +# -*- mode: org -*- +# vim: syntax=c From 09a6402783a964c5f0960f0937d7ede09f8c8bc1 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 15:34:58 +0100 Subject: [PATCH 47/61] Better org-mode for documentation --- src/README.org | 175 ++++++++-------- src/qmckl.org | 56 +++--- src/qmckl_ao.org | 306 ++++++++++++++-------------- src/qmckl_context.org | 446 ++++++++++++++++++++--------------------- src/qmckl_distance.org | 126 ++++++------ src/qmckl_footer.org | 5 + src/qmckl_memory.org | 86 ++++---- src/test_qmckl.org | 81 ++++---- 8 files changed, 635 insertions(+), 646 deletions(-) diff --git a/src/README.org b/src/README.org index 3601733..7ea4694 100644 --- a/src/README.org +++ b/src/README.org @@ -93,126 +93,117 @@ rm ${nb}.md Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. -* Design of the library +** Design of the library - The proposed API should allow the library to: - - deal with memory transfers between CPU and accelerators - - use different levels of floating-point precision + The proposed API should allow the library to: + - deal with memory transfers between CPU and accelerators + - use different levels of floating-point precision - We chose a multi-layered design with low-level and high-level - functions (see below). + We chose a multi-layered design with low-level and high-level + functions (see below). -** Naming conventions +*** Naming conventions - Use =qmckl_= as a prefix for all exported functions and variables. - All exported header files should have a filename with the prefix - =qmckl_=. + Use =qmckl_= as a prefix for all exported functions and variables. + All exported header files should have a filename with the prefix + =qmckl_=. - If the name of the org-mode file is =xxx.org=, the name of the - produced C files should be =xxx.c= and =xxx.h= and the name of the - produced Fortran files should be =xxx.f90= + If the name of the org-mode file is =xxx.org=, the name of the + produced C files should be =xxx.c= and =xxx.h= and the name of the + produced Fortran files should be =xxx.f90= - Arrays are in uppercase and scalars are in lowercase. + Arrays are in uppercase and scalars are in lowercase. -** Application programming interface +*** Application programming interface - The application programming interface (API) is designed to be - compatible with the C programming language (not C++), to ensure - that the library will be easily usable in any language. - This implies that only the following data types are allowed in the API: + The application programming interface (API) is designed to be + compatible with the C programming language (not C++), to ensure + that the library will be easily usable in any language. + This implies that only the following data types are allowed in the API: - - 32-bit and 64-bit floats and arrays (=real= and =double=) - - 32-bit and 64-bit integers and arrays (=int32_t= and =int64_t=) - - Pointers should be represented as 64-bit integers (even on - 32-bit architectures) - - ASCII strings are represented as a pointers to a character arrays - and terminated by a zero character (C convention). + - 32-bit and 64-bit floats and arrays (=real= and =double=) + - 32-bit and 64-bit integers and arrays (=int32_t= and =int64_t=) + - Pointers should be represented as 64-bit integers (even on + 32-bit architectures) + - ASCII strings are represented as a pointers to a character arrays + and terminated by a zero character (C convention). - Complex numbers can be represented by an array of 2 floats. + Complex numbers can be represented by an array of 2 floats. - # TODO : Link to repositories for bindings - To facilitate the use in other languages than C, we provide some - bindings in other languages in other repositories. + # TODO : Link to repositories for bindings + To facilitate the use in other languages than C, we provide some + bindings in other languages in other repositories. -** Global state +*** Global state - Global variables should be avoided in the library, because it is - possible that one single program needs to use multiple instances of - the library. To solve this problem we propose to use a pointer to a - =context= variable, built by the library with the - =qmckl_context_create= function. The =context= contains the global - state of the library, and is used as the first argument of many - QMCkl functions. + Global variables should be avoided in the library, because it is + possible that one single program needs to use multiple instances of + the library. To solve this problem we propose to use a pointer to a + =context= variable, built by the library with the + =qmckl_context_create= function. The =context= contains the global + state of the library, and is used as the first argument of many + QMCkl functions. - Modifying the state is done by setters and getters, prefixed - by =qmckl_context_set_= an =qmckl_context_get_=. - When a context variable is modified by a setter, a copy of the old - data structure is made and updated, and the pointer to the new data - structure is returned, such that the old contexts can still be - accessed. - It is also possible to modify the state in an impure fashion, using - the =qmckl_context_update_= functions. - The context and its old versions can be destroyed with - =qmckl_context_destroy=. + Modifying the state is done by setters and getters, prefixed + by =qmckl_context_set_= an =qmckl_context_get_=. + When a context variable is modified by a setter, a copy of the old + data structure is made and updated, and the pointer to the new data + structure is returned, such that the old contexts can still be + accessed. + It is also possible to modify the state in an impure fashion, using + the =qmckl_context_update_= functions. + The context and its old versions can be destroyed with + =qmckl_context_destroy=. -** Low-level functions +*** Low-level functions - Low-level functions are very simple functions which are leaves of the - function call tree (they don't call any other QMCkl function). + Low-level functions are very simple functions which are leaves of the + function call tree (they don't call any other QMCkl function). - This functions are /pure/, and unaware of the QMCkl =context=. They are - not allowed to allocate/deallocate memory, and if they need - temporary memory it should be provided in input. + This functions are /pure/, and unaware of the QMCkl =context=. They are + not allowed to allocate/deallocate memory, and if they need + temporary memory it should be provided in input. -** High-level functions +*** High-level functions - High-level functions are at the top of the function call tree. - They are able to choose which lower-level function to call - depending on the required precision, and do the corresponding type - conversions. - These functions are also responsible for allocating temporary - storage, to simplify the use of accelerators. + High-level functions are at the top of the function call tree. + They are able to choose which lower-level function to call + depending on the required precision, and do the corresponding type + conversions. + These functions are also responsible for allocating temporary + storage, to simplify the use of accelerators. - The high-level functions should be pure, unless the introduction of - non-purity is justified. All the side effects should be made in the - =context= variable. + The high-level functions should be pure, unless the introduction of + non-purity is justified. All the side effects should be made in the + =context= variable. - # TODO : We need an identifier for impure functions + # TODO : We need an identifier for impure functions -** Numerical precision +*** Numerical precision - The number of bits of precision required for a function should be - given as an input of low-level computational functions. This input will - be used to define the values of the different thresholds that might - be used to avoid computing unnecessary noise. - High-level functions will use the precision specified in the - =context= variable. + The number of bits of precision required for a function should be + given as an input of low-level computational functions. This input will + be used to define the values of the different thresholds that might + be used to avoid computing unnecessary noise. + High-level functions will use the precision specified in the + =context= variable. -* Algorithms +** Algorithms - Reducing the scaling of an algorithm usually implies also reducing - its arithmetic complexity (number of flops per byte). Therefore, - for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms - are better adapted than linear scaling algorithms. - As QMCkl is a general purpose library, multiple algorithms should - be implemented adapted to different problem sizes. + Reducing the scaling of an algorithm usually implies also reducing + its arithmetic complexity (number of flops per byte). Therefore, + for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms + are better adapted than linear scaling algorithms. + As QMCkl is a general purpose library, multiple algorithms should + be implemented adapted to different problem sizes. -* Rules for the API +** Rules for the API - - =stdint= should be used for integers (=int32_t=, =int64_t=) - - integers used for counting should always be =int64_t= - - floats should be by default =double=, unless explicitly mentioned - - pointers are converted to =int64_t= to increase portability + - =stdint= should be used for integers (=int32_t=, =int64_t=) + - integers used for counting should always be =int64_t= + - floats should be by default =double=, unless explicitly mentioned + - pointers are converted to =int64_t= to increase portability * Documentation - - [[./qmckl.org][Main QMCkl header file]] - - [[./qmckl_memory.org][Memory management]] - - [[./qmckl_context.org][Context]] - - [[./qmckl_distance.org][Distance]] - - [[./qmckl_ao.org][Atomic orbitals]] -* Acknowledgments - - [[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] - [[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. diff --git a/src/qmckl.org b/src/qmckl.org index ad77abd..7620883 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -1,63 +1,63 @@ -* QMCKL header file +** =qmckl.h= header file -This file produces the =qmckl.h= header file, which is to be included -when qmckl functions are used. + This file produces the =qmckl.h= header file, which is to be included + when qmckl functions are used. -We also create here the =qmckl_f.f90= which is the Fortran interface file. + We also create here the =qmckl_f.f90= which is the Fortran interface file. -** Top of header files :noexport: +*** Top of header files :noexport: - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :tangle qmckl.h #ifndef QMCKL_H #define QMCKL_H #include #include - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 module qmckl use, intrinsic :: iso_c_binding - #+END_SRC + #+END_SRC - The bottoms of the files are located in the [[qmckl_footer.org]] file. + The bottoms of the files are located in the [[qmckl_footer.org]] file. -** Constants +*** Constants -*** Success/failure +**** Success/failure - These are the codes returned by the functions to indicate success - or failure. All such functions should have as a return type =qmckl_exit_code=. + These are the codes returned by the functions to indicate success + or failure. All such functions should have as a return type =qmckl_exit_code=. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle qmckl.h #define QMCKL_SUCCESS 0 #define QMCKL_FAILURE 1 typedef int32_t qmckl_exit_code; typedef int64_t qmckl_context ; - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 integer, parameter :: QMCKL_SUCCESS = 0 integer, parameter :: QMCKL_FAILURE = 0 - #+END_SRC + #+END_SRC -*** Precision-related constants +**** Precision-related constants - Controlling numerical precision enables optimizations. Here, the - default parameters determining the target numerical precision and - range are defined. + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle qmckl.h #define QMCKL_DEFAULT_PRECISION 53 #define QMCKL_DEFAULT_RANGE 11 - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90 integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 integer, parameter :: QMCKL_DEFAULT_RANGE = 11 - #+END_SRC + #+END_SRC - # -*- mode: org -*- - # vim: syntax=c + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index bcd46ed..506beb8 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -1,79 +1,79 @@ -* Atomic Orbitals +** Atomic Orbitals -This files contains all the routines for the computation of the -values, gradients and Laplacian of the atomic basis functions. + This files contains all the routines for the computation of the + values, gradients and Laplacian of the atomic basis functions. -3 files are produced: -- a source file : =qmckl_ao.f90= -- a C test file : =test_qmckl_ao.c= -- a Fortran test file : =test_qmckl_ao_f.f90= + 3 files are produced: + - a source file : =qmckl_ao.f90= + - a C test file : =test_qmckl_ao.c= + - a Fortran test file : =test_qmckl_ao_f.f90= -** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_ao.c +*** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_ao.c #include #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_ao() { qmckl_context context; context = qmckl_context_create(); - #+END_SRC + #+END_SRC -** Polynomials +*** Polynomials - \[ - P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c - \] - \begin{eqnarray*} - \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ - \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ - \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ - \end{eqnarray*} - \begin{eqnarray*} - \left( \frac{\partial }{\partial x^2} + - \frac{\partial }{\partial y^2} + - \frac{\partial }{\partial z^2} \right) P_l - \left(\mathbf{r},\mathbf{R}_i \right) & = & - a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ - && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ - && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} - \end{eqnarray*} + \[ + P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c + \] + \begin{eqnarray*} + \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ + \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ + \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ + \end{eqnarray*} + \begin{eqnarray*} + \left( \frac{\partial }{\partial x^2} + + \frac{\partial }{\partial y^2} + + \frac{\partial }{\partial z^2} \right) P_l + \left(\mathbf{r},\mathbf{R}_i \right) & = & + a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\ + && b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\ + && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} + \end{eqnarray*} -*** =qmckl_ao_powers= +**** =qmckl_ao_powers= - Computes all the powers of the =n= input data up to the given - maximum value given in input for each of the $n$ points: + Computes all the powers of the =n= input data up to the given + maximum value given in input for each of the $n$ points: - \[ P_{ij} = X_j^i \] + \[ P_{ij} = X_j^i \] -**** Arguments +***** Arguments - | =context= | input | Global state | - | =n= | input | Number of values | - | =X(n)= | input | Array containing the input values | - | =LMAX(n)= | input | Array containing the maximum power for each value | - | =P(LDP,n)= | output | Array containing all the powers of =X= | - | =LDP= | input | Leading dimension of array =P= | + | =context= | input | Global state | + | =n= | input | Number of values | + | =X(n)= | input | Array containing the input values | + | =LMAX(n)= | input | Array containing the maximum power for each value | + | =P(LDP,n)= | output | Array containing all the powers of =X= | + | =LDP= | input | Leading dimension of array =P= | -**** Requirements +***** Requirements - - =context= is not 0 - - =n= > 0 - - =X= is allocated with at least $n \times 8$ bytes - - =LMAX= is allocated with at least $n \times 4$ bytes - - =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - - =LDP= >= $\max_i$ =LMAX[i]= + - =context= is not 0 + - =n= > 0 + - =X= is allocated with at least $n \times 8$ bytes + - =LMAX= is allocated with at least $n \times 4$ bytes + - =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes + - =LDP= >= $\max_i$ =LMAX[i]= -**** Header - #+BEGIN_SRC C :tangle qmckl.h +***** Header + #+BEGIN_SRC C :tangle qmckl.h qmckl_exit_code qmckl_ao_powers(const qmckl_context context, const int64_t n, const double *X, const int32_t *LMAX, const double *P, const int64_t LDP); - #+END_SRC + #+END_SRC -**** Source - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 +***** Source + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) implicit none integer*8 , intent(in) :: context @@ -105,10 +105,10 @@ integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) end do end function qmckl_ao_powers_f - #+END_SRC + #+END_SRC -**** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 +***** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -123,9 +123,9 @@ integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & integer, external :: qmckl_ao_powers_f info = qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) end function qmckl_ao_powers - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) bind(C) use, intrinsic :: iso_c_binding @@ -137,10 +137,10 @@ end function qmckl_ao_powers real (c_double) , intent(out) :: P(ldp,n) end function qmckl_ao_powers end interface - #+END_SRC + #+END_SRC -**** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 +***** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) use qmckl implicit none @@ -183,55 +183,55 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) test_qmckl_ao_powers = 0 deallocate(X,P,LMAX) end function test_qmckl_ao_powers - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle test_qmckl_ao.c int test_qmckl_ao_powers(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_powers(context)); - #+END_SRC + #+END_SRC -*** =qmckl_ao_polynomial_vgl= +**** =qmckl_ao_polynomial_vgl= - Computes the values, gradients and Laplacians at a given point of - all polynomials with an angular momentum up to =lmax=. + Computes the values, gradients and Laplacians at a given point of + all polynomials with an angular momentum up to =lmax=. -**** Arguments +***** Arguments - | =context= | input | Global state | - | =X(3)= | input | Array containing the coordinates of the points | - | =R(3)= | input | Array containing the x,y,z coordinates of the center | - | =lmax= | input | Maximum angular momentum | - | =n= | output | Number of computed polynomials | - | =L(ldl,n)= | output | Contains a,b,c for all =n= results | - | =ldl= | input | Leading dimension of =L= | - | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials | - | =ldv= | input | Leading dimension of array =VGL= | + | =context= | input | Global state | + | =X(3)= | input | Array containing the coordinates of the points | + | =R(3)= | input | Array containing the x,y,z coordinates of the center | + | =lmax= | input | Maximum angular momentum | + | =n= | output | Number of computed polynomials | + | =L(ldl,n)= | output | Contains a,b,c for all =n= results | + | =ldl= | input | Leading dimension of =L= | + | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials | + | =ldv= | input | Leading dimension of array =VGL= | -**** Requirements +***** Requirements - - =context= is not 0 - - =n= > 0 - - =lmax= >= 0 - - =ldl= >= 3 - - =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 - - =X= is allocated with at least $3 \times 8$ bytes - - =R= is allocated with at least $3 \times 8$ bytes - - =L= is allocated with at least $3 \times n \times 4$ bytes - - =VGL= is allocated with at least $n \times 5 \times 8$ bytes - - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 + - =context= is not 0 + - =n= > 0 + - =lmax= >= 0 + - =ldl= >= 3 + - =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 + - =X= is allocated with at least $3 \times 8$ bytes + - =R= is allocated with at least $3 \times 8$ bytes + - =L= is allocated with at least $3 \times n \times 4$ bytes + - =VGL= is allocated with at least $n \times 5 \times 8$ bytes + - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 -**** Header - #+BEGIN_SRC C :tangle qmckl.h +***** Header + #+BEGIN_SRC C :tangle qmckl.h qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, const double *X, const double *R, const int32_t lmax, const int64_t *n, const int32_t *L, const int64_t ldl, const double *VGL, const int64_t ldv); - #+END_SRC + #+END_SRC -**** Source - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 +***** Source + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -340,10 +340,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, info = 0 end function qmckl_ao_polynomial_vgl_f - #+END_SRC + #+END_SRC -**** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 +***** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -360,9 +360,9 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l integer, external :: qmckl_ao_polynomial_vgl_f info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) end function qmckl_ao_polynomial_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & bind(C) @@ -377,9 +377,9 @@ end function qmckl_ao_polynomial_vgl real (c_double) , intent(out) :: VGL(ldv,5) end function qmckl_ao_polynomial_vgl end interface - #+END_SRC -**** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 + #+END_SRC +***** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) use qmckl implicit none @@ -472,58 +472,58 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) deallocate(L,VGL) end function test_qmckl_ao_polynomial_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle test_qmckl_ao.c int test_qmckl_ao_polynomial_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); - #+END_SRC - #+END_SRC + #+END_SRC + #+END_SRC -** Gaussian basis functions +*** Gaussian basis functions -*** =qmckl_ao_gaussians_vgl= +**** =qmckl_ao_gaussians_vgl= - Computes the values, gradients and Laplacians at a given point of - =n= Gaussian functions centered at the same point: + Computes the values, gradients and Laplacians at a given point of + =n= Gaussian functions centered at the same point: - \[ v_i = exp(-a_i |X-R|^2) \] - \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] - \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] - \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] - \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] + \[ v_i = exp(-a_i |X-R|^2) \] + \[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \] + \[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \] + \[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \] + \[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \] -**** Arguments +***** Arguments - | =context= | input | Global state | - | =X(3)= | input | Array containing the coordinates of the points | - | =R(3)= | input | Array containing the x,y,z coordinates of the center | - | =n= | input | Number of computed gaussians | - | =A(n)= | input | Exponents of the Gaussians | - | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians | - | =ldv= | input | Leading dimension of array =VGL= | + | =context= | input | Global state | + | =X(3)= | input | Array containing the coordinates of the points | + | =R(3)= | input | Array containing the x,y,z coordinates of the center | + | =n= | input | Number of computed gaussians | + | =A(n)= | input | Exponents of the Gaussians | + | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians | + | =ldv= | input | Leading dimension of array =VGL= | -**** Requirements +***** Requirements - - =context= is not 0 - - =n= > 0 - - =ldv= >= 5 - - =A(i)= > 0 for all =i= - - =X= is allocated with at least $3 \times 8$ bytes - - =R= is allocated with at least $3 \times 8$ bytes - - =A= is allocated with at least $n \times 8$ bytes - - =VGL= is allocated with at least $n \times 5 \times 8$ bytes + - =context= is not 0 + - =n= > 0 + - =ldv= >= 5 + - =A(i)= > 0 for all =i= + - =X= is allocated with at least $3 \times 8$ bytes + - =R= is allocated with at least $3 \times 8$ bytes + - =A= is allocated with at least $n \times 8$ bytes + - =VGL= is allocated with at least $n \times 5 \times 8$ bytes -**** Header - #+BEGIN_SRC C :tangle qmckl.h +***** Header + #+BEGIN_SRC C :tangle qmckl.h qmckl_exit_code qmckl_ao_gaussians_vgl(const qmckl_context context, const double *X, const double *R, const int64_t *n, const int64_t *A, const double *VGL, const int64_t ldv); - #+END_SRC + #+END_SRC -**** Source - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 +***** Source + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context @@ -583,10 +583,10 @@ integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result( end do end function qmckl_ao_gaussians_vgl_f - #+END_SRC + #+END_SRC -**** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_ao.f90 +***** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_ao.f90 integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -601,9 +601,9 @@ integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv integer, external :: qmckl_ao_gaussians_vgl_f info = qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) end function qmckl_ao_gaussians_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & bind(C) @@ -615,9 +615,9 @@ end function qmckl_ao_gaussians_vgl real (c_double) , intent(out) :: VGL(ldv,5) end function qmckl_ao_gaussians_vgl end interface - #+END_SRC -**** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 + #+END_SRC +***** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) use qmckl implicit none @@ -682,28 +682,28 @@ integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) deallocate(VGL) end function test_qmckl_ao_gaussians_vgl - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_ao.c + #+BEGIN_SRC C :tangle test_qmckl_ao.c int test_qmckl_ao_gaussians_vgl(qmckl_context context); munit_assert_int(0, ==, test_qmckl_ao_gaussians_vgl(context)); - #+END_SRC - #+END_SRC + #+END_SRC + #+END_SRC -** TODO Slater basis functions +*** TODO Slater basis functions -** End of files :noexport: +*** End of files :noexport: -**** Test - #+BEGIN_SRC C :tangle test_qmckl_ao.c +***** Test + #+BEGIN_SRC C :tangle test_qmckl_ao.c if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return MUNIT_OK; } - #+END_SRC + #+END_SRC - # -*- mode: org -*- - # vim: syntax=c + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_context.org b/src/qmckl_context.org index dc1eeca..e407466 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,41 +1,41 @@ -* Context +** Context - This file is written in C because it is more natural to express the context in - C than in Fortran. + This file is written in C because it is more natural to express the context in + C than in Fortran. - 2 files are produced: - - a source file : =qmckl_context.c= - - a test file : =test_qmckl_context.c= + 2 files are produced: + - a source file : =qmckl_context.c= + - a test file : =test_qmckl_context.c= -** Headers :noexport: - #+BEGIN_SRC C :tangle qmckl_context.c +*** Headers :noexport: + #+BEGIN_SRC C :tangle qmckl_context.c #include "qmckl.h" - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_context.c + #+BEGIN_SRC C :tangle test_qmckl_context.c #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_context() { - #+END_SRC + #+END_SRC -** Context +*** Context - The context variable is a handle for the state of the library, and - is stored in the following data structure, which can't be seen - outside of the library. To simplify compatibility with other - languages, the pointer to the internal data structure is converted - into a 64-bit signed integer, defined in the =qmckl_context= type. - A value of 0 for the context is equivalent to a =NULL= pointer. + The context variable is a handle for the state of the library, and + is stored in the following data structure, which can't be seen + outside of the library. To simplify compatibility with other + languages, the pointer to the internal data structure is converted + into a 64-bit signed integer, defined in the =qmckl_context= type. + A value of 0 for the context is equivalent to a =NULL= pointer. - #+BEGIN_SRC C :comments org :tangle qmckl.h - #+END_SRC + #+BEGIN_SRC C :comments org :tangle qmckl.h + #+END_SRC -**** Source +***** Source - The tag is used internally to check if the memory domain pointed by - a pointer is a valid context. + The tag is used internally to check if the memory domain pointed by + a pointer is a valid context. - #+BEGIN_SRC C :comments org :tangle qmckl_context.c + #+BEGIN_SRC C :comments org :tangle qmckl_context.c typedef struct qmckl_context_struct { struct qmckl_context_struct * prev; uint32_t tag; @@ -45,26 +45,26 @@ typedef struct qmckl_context_struct { #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF - #+END_SRC + #+END_SRC -**** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_context.c +***** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_context.c qmckl_context context; qmckl_context new_context; + #+END_SRC + + +**** =qmckl_context_check= + + Checks if the domain pointed by the pointer is a valid context. + Returns the input =qmckl_context= if the context is valid, 0 otherwise. + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_context qmckl_context_check(const qmckl_context context) ; #+END_SRC - -*** =qmckl_context_check= - - Checks if the domain pointed by the pointer is a valid context. - Returns the input =qmckl_context= if the context is valid, 0 otherwise. - - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_context qmckl_context_check(const qmckl_context context) ; - #+END_SRC - -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_check(const qmckl_context context) { if (context == (qmckl_context) 0) return (qmckl_context) 0; @@ -75,20 +75,20 @@ qmckl_context qmckl_context_check(const qmckl_context context) { return context; } - #+END_SRC - -*** =qmckl_context_create= - - To create a new context, use =qmckl_context_create()=. - - On success, returns a pointer to a context using the =qmckl_context= type - - Returns 0 upon failure to allocate the internal data structure - - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_context qmckl_context_create(); #+END_SRC -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +**** =qmckl_context_create= + + To create a new context, use =qmckl_context_create()=. + - On success, returns a pointer to a context using the =qmckl_context= type + - Returns 0 upon failure to allocate the internal data structure + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_context qmckl_context_create(); + #+END_SRC + +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_create() { qmckl_context_struct* context = @@ -104,38 +104,38 @@ qmckl_context qmckl_context_create() { return (qmckl_context) context; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int64_t) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding end function qmckl_context_create end interface - #+END_SRC + #+END_SRC -**** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +***** Test :noexport: + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c context = qmckl_context_create(); munit_assert_int64( context, !=, (qmckl_context) 0); munit_assert_int64( qmckl_context_check(context), ==, context); - #+END_SRC - -*** =qmckl_context_copy= - - This function makes a shallow copy of the current context. - - Copying the 0-valued context returns 0 - - On success, returns a pointer to the new context using the =qmckl_context= type - - Returns 0 upon failure to allocate the internal data structure - for the new context - - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_context qmckl_context_copy(const qmckl_context context); #+END_SRC -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +**** =qmckl_context_copy= + + This function makes a shallow copy of the current context. + - Copying the 0-valued context returns 0 + - On success, returns a pointer to the new context using the =qmckl_context= type + - Returns 0 upon failure to allocate the internal data structure + for the new context + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_context qmckl_context_copy(const qmckl_context context); + #+END_SRC + +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_copy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -160,39 +160,39 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { return (qmckl_context) new_context; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int64_t) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_copy end interface - #+END_SRC + #+END_SRC -**** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +***** Test :noexport: + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c new_context = qmckl_context_copy(context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); - #+END_SRC - -*** =qmckl_context_previous= - - Returns the previous context - - On success, returns the ancestor of the current context - - Returns 0 for the initial context - - Returns 0 for the 0-valued context - - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_context qmckl_context_previous(const qmckl_context context); #+END_SRC -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +**** =qmckl_context_previous= + + Returns the previous context + - On success, returns the ancestor of the current context + - Returns 0 for the initial context + - Returns 0 for the 0-valued context + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_context qmckl_context_previous(const qmckl_context context); + #+END_SRC + +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -203,40 +203,40 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; return qmckl_context_check((qmckl_context) ctx->prev); } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int64_t) function qmckl_context_previous(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_previous end interface - #+END_SRC + #+END_SRC -**** Test :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +***** Test :noexport: + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous(new_context), ==, context); munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); - #+END_SRC - -*** =qmckl_context_destroy= - - Destroys the current context, leaving the ancestors untouched. - - Succeeds if the current context is properly destroyed - - Fails otherwise - - Fails if the 0-valued context is given in argument - - Fails if the the pointer is not a valid context - - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_exit_code qmckl_context_destroy(qmckl_context context); #+END_SRC -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +**** =qmckl_context_destroy= + + Destroys the current context, leaving the ancestors untouched. + - Succeeds if the current context is properly destroyed + - Fails otherwise + - Fails if the 0-valued context is given in argument + - Fails if the the pointer is not a valid context + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_exit_code qmckl_context_destroy(qmckl_context context); + #+END_SRC + +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); @@ -249,47 +249,47 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { qmckl_free(ctx); return QMCKL_SUCCESS; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_destroy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_destroy end interface - #+END_SRC + #+END_SRC -**** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_context.c +***** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_context.c munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); munit_assert_int64(qmckl_context_check(new_context), !=, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); + #+END_SRC + + +*** Precision + + The following functions set and get the expected required precision + and range. =precision= should be an integer between 2 and 53, and + =range= should be an integer between 2 and 11. + + The setter functions functions return a new context as a 64-bit integer. + The getter functions return the value, as a 32-bit integer. + The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. + +**** =qmckl_context_update_precision= + Modifies the parameter for the numerical precision in a given context. + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC - -** Precision - - The following functions set and get the expected required precision - and range. =precision= should be an integer between 2 and 53, and - =range= should be an integer between 2 and 11. - - The setter functions functions return a new context as a 64-bit integer. - The getter functions return the value, as a 32-bit integer. - The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. - -*** =qmckl_context_update_precision= - Modifies the parameter for the numerical precision in a given context. - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); - #+END_SRC - -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { if (precision < 2) return QMCKL_FAILURE; @@ -301,10 +301,10 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons ctx->precision = precision; return QMCKL_SUCCESS; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -312,17 +312,17 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons integer (c_int32_t), intent(in), value :: precision end function qmckl_context_update_precision end interface - #+END_SRC + #+END_SRC -**** TODO Tests :noexport: -*** =qmckl_context_update_range= - Modifies the parameter for the numerical range in a given context. - #+BEGIN_SRC C :comments org :tangle qmckl.h +***** TODO Tests :noexport: +**** =qmckl_context_update_range= + Modifies the parameter for the numerical range in a given context. + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); - #+END_SRC + #+END_SRC -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { if (range < 2) return QMCKL_FAILURE; @@ -334,10 +334,10 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in ctx->range = range; return QMCKL_SUCCESS; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -345,17 +345,17 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in integer (c_int32_t), intent(in), value :: range end function qmckl_context_update_range end interface + #+END_SRC + +***** TODO Tests :noexport: +**** =qmckl_context_set_precision= + Returns a copy of the context with a different precision parameter. + #+BEGIN_SRC C :comments or :tangle qmckl.h +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC -**** TODO Tests :noexport: -*** =qmckl_context_set_precision= - Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments or :tangle qmckl.h -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); - #+END_SRC - -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -364,10 +364,10 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int return new_context; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_set_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding @@ -375,17 +375,17 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int integer (c_int32_t), intent(in), value :: precision end function qmckl_context_set_precision end interface + #+END_SRC + +***** TODO Tests :noexport: +**** =qmckl_context_set_range= + Returns a copy of the context with a different precision parameter. + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC -**** TODO Tests :noexport: -*** =qmckl_context_set_range= - Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments org :tangle qmckl.h -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); - #+END_SRC - -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; @@ -394,10 +394,10 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran return new_context; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_set_range(context, range) bind(C) use, intrinsic :: iso_c_binding @@ -405,102 +405,102 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran integer (c_int32_t), intent(in), value :: range end function qmckl_context_set_range end interface + #+END_SRC + +***** TODO Tests :noexport: + +**** =qmckl_context_get_precision= + Returns the value of the numerical precision in the context + #+BEGIN_SRC C :comments org :tangle qmckl.h +int32_t qmckl_context_get_precision(const qmckl_context context); #+END_SRC -**** TODO Tests :noexport: - -*** =qmckl_context_get_precision= - Returns the value of the numerical precision in the context - #+BEGIN_SRC C :comments org :tangle qmckl.h -int32_t qmckl_context_get_precision(const qmckl_context context); - #+END_SRC - -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c int qmckl_context_get_precision(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->precision; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_precision end interface + #+END_SRC + +***** TODO Tests :noexport: +**** =qmckl_context_get_range= + Returns the value of the numerical range in the context + #+BEGIN_SRC C :comments org :tangle qmckl.h +int32_t qmckl_context_get_range(const qmckl_context context); #+END_SRC -**** TODO Tests :noexport: -*** =qmckl_context_get_range= - Returns the value of the numerical range in the context - #+BEGIN_SRC C :comments org :tangle qmckl.h -int32_t qmckl_context_get_range(const qmckl_context context); - #+END_SRC - -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c int qmckl_context_get_range(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->range; } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer (c_int32_t) function qmckl_context_get_range(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_range end interface + #+END_SRC + +***** TODO Tests :noexport: + +**** =qmckl_context_get_epsilon= + Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision + #+BEGIN_SRC C :comments org :tangle qmckl.h +double qmckl_context_get_epsilon(const qmckl_context context); #+END_SRC -**** TODO Tests :noexport: - -*** =qmckl_context_get_epsilon= - Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision - #+BEGIN_SRC C :comments org :tangle qmckl.h -double qmckl_context_get_epsilon(const qmckl_context context); - #+END_SRC - -**** Source - #+BEGIN_SRC C :tangle qmckl_context.c +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c double qmckl_context_get_epsilon(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return 1.0 / ((double) ((int64_t) 1 << (ctx->precision-1))); } - #+END_SRC + #+END_SRC -**** Fortran interface - #+BEGIN_SRC f90 :tangle qmckl_f.f90 +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface real (c_double) function qmckl_context_get_epsilon(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_epsilon end interface - #+END_SRC + #+END_SRC -**** TODO Tests :noexport: +***** TODO Tests :noexport: -** Info about the molecular system +*** Info about the molecular system -*** TODO =qmckl_context_set_nucl_coord= -*** TODO =qmckl_context_set_nucl_charge= -*** TODO =qmckl_context_set_elec_num= +**** TODO =qmckl_context_set_nucl_coord= +**** TODO =qmckl_context_set_nucl_charge= +**** TODO =qmckl_context_set_elec_num= -** End of files :noexport: +*** End of files :noexport: -**** Test - #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c +***** Test + #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c return MUNIT_OK; } - #+END_SRC + #+END_SRC -# -*- mode: org -*- -# vim: syntax=c + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index f50361d..06c8015 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -1,14 +1,14 @@ -* Computation of distances +** Computation of distances -Function for the computation of distances between particles. + Function for the computation of distances between particles. -3 files are produced: -- a source file : =qmckl_distance.f90= -- a C test file : =test_qmckl_distance.c= -- a Fortran test file : =test_qmckl_distance_f.f90= + 3 files are produced: + - a source file : =qmckl_distance.f90= + - a C test file : =test_qmckl_distance.c= + - a Fortran test file : =test_qmckl_distance_f.f90= -*** Headers :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c +**** Headers :noexport: + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c #include #include "qmckl.h" #include "munit.h" @@ -16,63 +16,63 @@ MunitResult test_qmckl_distance() { qmckl_context context; context = qmckl_context_create(); - #+END_SRC + #+END_SRC -** Squared distance +*** Squared distance -*** =qmckl_distance_sq= +**** =qmckl_distance_sq= - Computes the matrix of the squared distances between all pairs of - points in two sets, one point within each set: - \[ - C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 - \] + Computes the matrix of the squared distances between all pairs of + points in two sets, one point within each set: + \[ + C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 + \] -**** Arguments +***** Arguments - | =context= | input | Global state | - | =transa= | input | Array =A= is =N=: Normal, =T=: Transposed | - | =transb= | input | Array =B= is =N=: Normal, =T=: Transposed | - | =m= | input | Number of points in the first set | - | =n= | input | Number of points in the second set | - | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | - | =lda= | input | Leading dimension of array =A= | - | =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ | - | =ldb= | input | Leading dimension of array =B= | - | =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ | - | =ldc= | input | Leading dimension of array =C= | + | =context= | input | Global state | + | =transa= | input | Array =A= is =N=: Normal, =T=: Transposed | + | =transb= | input | Array =B= is =N=: Normal, =T=: Transposed | + | =m= | input | Number of points in the first set | + | =n= | input | Number of points in the second set | + | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | + | =lda= | input | Leading dimension of array =A= | + | =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ | + | =ldb= | input | Leading dimension of array =B= | + | =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ | + | =ldc= | input | Leading dimension of array =C= | -**** Requirements +***** Requirements - - =context= is not 0 - - =m= > 0 - - =n= > 0 - - =lda= >= 3 if =transa= is =N= - - =lda= >= m if =transa= is =T= - - =ldb= >= 3 if =transb= is =N= - - =ldb= >= n if =transb= is =T= - - =ldc= >= m if =transa= is = - - =A= is allocated with at least $3 \times m \times 8$ bytes - - =B= is allocated with at least $3 \times n \times 8$ bytes - - =C= is allocated with at least $m \times n \times 8$ bytes + - =context= is not 0 + - =m= > 0 + - =n= > 0 + - =lda= >= 3 if =transa= is =N= + - =lda= >= m if =transa= is =T= + - =ldb= >= 3 if =transb= is =N= + - =ldb= >= n if =transb= is =T= + - =ldc= >= m if =transa= is = + - =A= is allocated with at least $3 \times m \times 8$ bytes + - =B= is allocated with at least $3 \times n \times 8$ bytes + - =C= is allocated with at least $m \times n \times 8$ bytes -**** Performance +***** Performance - This function might be more efficient when =A= and =B= are - transposed. + This function might be more efficient when =A= and =B= are + transposed. - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_distance_sq(const qmckl_context context, const char transa, const char transb, const int64_t m, const int64_t n, const double *A, const int64_t lda, const double *B, const int64_t ldb, const double *C, const int64_t ldc); - #+END_SRC + #+END_SRC -**** Source - #+BEGIN_SRC f90 :tangle qmckl_distance.f90 +***** Source + #+BEGIN_SRC f90 :tangle qmckl_distance.f90 integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) implicit none integer*8 , intent(in) :: context @@ -197,10 +197,10 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L end select end function qmckl_distance_sq_f - #+END_SRC + #+END_SRC -**** C interface :noexport: - #+BEGIN_SRC f90 :tangle qmckl_distance.f90 +***** C interface :noexport: + #+BEGIN_SRC f90 :tangle qmckl_distance.f90 integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) result(info) use, intrinsic :: iso_c_binding @@ -218,9 +218,9 @@ integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, integer, external :: qmckl_distance_sq_f info = qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) end function qmckl_distance_sq - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & bind(C) @@ -237,10 +237,10 @@ end function qmckl_distance_sq real (c_double) , intent(out) :: C(ldc,n) end function qmckl_distance_sq end interface - #+END_SRC + #+END_SRC -**** Test :noexport: - #+BEGIN_SRC f90 :tangle test_qmckl_distance_f.f90 +***** Test :noexport: + #+BEGIN_SRC f90 :tangle test_qmckl_distance_f.f90 integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) use qmckl implicit none @@ -336,22 +336,22 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) deallocate(A,B,C) end function test_qmckl_distance_sq - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c int test_qmckl_distance_sq(qmckl_context context); munit_assert_int(0, ==, test_qmckl_distance_sq(context)); - #+END_SRC -** End of files :noexport: + #+END_SRC +*** End of files :noexport: - #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c + #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return MUNIT_OK; } - #+END_SRC + #+END_SRC -# -*- mode: org -*- -# vim: syntax=c + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/qmckl_footer.org b/src/qmckl_footer.org index 53fab1b..5ed01c7 100644 --- a/src/qmckl_footer.org +++ b/src/qmckl_footer.org @@ -1,3 +1,8 @@ +* Acknowledgments + + [[https://trex-coe.eu/sites/default/files/inline-images/euflag.jpg]] + [[https://trex-coe.eu][TREX: Targeting Real Chemical Accuracy at the Exascale]] project has received funding from the European Union’s Horizon 2020 - Research and Innovation program - under grant agreement no. 952165. The content of this document does not represent the opinion of the European Union, and the European Union is not responsible for any use that might be made of such content. + * End of header files :noexport: #+BEGIN_SRC C :tangle qmckl.h diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index cf16b9e..7e3ca79 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -1,33 +1,33 @@ -* Memory management +** Memory management -We override the allocation functions to enable the possibility of -optimized libraries to fine-tune the memory allocation. + We override the allocation functions to enable the possibility of + optimized libraries to fine-tune the memory allocation. -2 files are produced: -- a source file : =qmckl_memory.c= -- a test file : =test_qmckl_memory.c= + 2 files are produced: + - a source file : =qmckl_memory.c= + - a test file : =test_qmckl_memory.c= -** Headers :noexport: - #+BEGIN_SRC C :tangle qmckl_memory.c +*** Headers :noexport: + #+BEGIN_SRC C :tangle qmckl_memory.c #include "qmckl.h" - #+END_SRC + #+END_SRC - #+BEGIN_SRC C :tangle test_qmckl_memory.c + #+BEGIN_SRC C :tangle test_qmckl_memory.c #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_memory() { - #+END_SRC + #+END_SRC -** =qmckl_malloc= +*** =qmckl_malloc= - Memory allocation function, letting the library choose how the - memory will be allocated, and a pointer is returned to the user. + Memory allocation function, letting the library choose how the + memory will be allocated, and a pointer is returned to the user. - #+BEGIN_SRC C :tangle qmckl.h + #+BEGIN_SRC C :tangle qmckl.h void* qmckl_malloc(const qmckl_context ctx, const size_t size); - #+END_SRC + #+END_SRC - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface type (c_ptr) function qmckl_malloc (context, size) bind(C) use, intrinsic :: iso_c_binding @@ -35,10 +35,10 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size); integer (c_int64_t), intent(in), value :: size end function qmckl_malloc end interface - #+END_SRC + #+END_SRC -*** Source - #+BEGIN_SRC C :tangle qmckl_memory.c +**** Source + #+BEGIN_SRC C :tangle qmckl_memory.c void* qmckl_malloc(const qmckl_context ctx, const size_t size) { if (ctx == (qmckl_context) 0) { /* Avoids unused parameter error */ @@ -47,10 +47,10 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size) { return malloc( (size_t) size ); } - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_memory.c +**** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_memory.c int *a; a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); a[0] = 1; @@ -59,43 +59,43 @@ a[2] = 3; munit_assert_int(a[0], ==, 1); munit_assert_int(a[1], ==, 2); munit_assert_int(a[2], ==, 3); + #+END_SRC + +*** =qmckl_free= + + #+BEGIN_SRC C :tangle qmckl.h +void qmckl_free(void *ptr); #+END_SRC -** =qmckl_free= - - #+BEGIN_SRC C :tangle qmckl.h -void qmckl_free(void *ptr); - #+END_SRC - - #+BEGIN_SRC f90 :tangle qmckl_f.f90 + #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface subroutine qmckl_free (ptr) bind(C) use, intrinsic :: iso_c_binding type (c_ptr), intent(in), value :: ptr end subroutine qmckl_free end interface - #+END_SRC -*** Source - #+BEGIN_SRC C :tangle qmckl_memory.c + #+END_SRC +**** Source + #+BEGIN_SRC C :tangle qmckl_memory.c void qmckl_free(void *ptr) { free(ptr); } - #+END_SRC + #+END_SRC -*** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_memory.c +**** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_memory.c qmckl_free(a); - #+END_SRC + #+END_SRC -** End of files :noexport: +*** End of files :noexport: -*** Test - #+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c +**** Test + #+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c return MUNIT_OK; } - #+END_SRC + #+END_SRC -# -*- mode: org -*- -# vim: syntax=c + # -*- mode: org -*- + # vim: syntax=c diff --git a/src/test_qmckl.org b/src/test_qmckl.org index bcd0fce..1489768 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -1,18 +1,11 @@ -#+TITLE: QMCkl test +* QMCkl test :noexport: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: + This file is the main program of the unit tests. The tests rely on the + $\mu$unit framework, which is provided as a git submodule. -This file is the main program of the unit tests. The tests rely on the -$\mu$unit framework, which is provided as a git submodule. - -First, we use a script to find the list of all the produced test files: -#+NAME: test-files -#+BEGIN_SRC sh :exports none :results value + First, we use a script to find the list of all the produced test files: + #+NAME: test-files + #+BEGIN_SRC sh :exports none :results value grep BEGIN_SRC *.org | \ grep test_qmckl_ | \ rev | \ @@ -20,57 +13,57 @@ grep BEGIN_SRC *.org | \ rev | \ sort | \ uniq -#+END_SRC + #+END_SRC -#+RESULTS: test-files -| test_qmckl_ao.c | -| test_qmckl_context.c | -| test_qmckl_distance.c | -| test_qmckl_memory.c | + #+RESULTS: test-files + | test_qmckl_ao.c | + | test_qmckl_context.c | + | test_qmckl_distance.c | + | test_qmckl_memory.c | -We generate the function headers -#+BEGIN_SRC sh :var files=test-files :exports output :results raw + We generate the function headers + #+BEGIN_SRC sh :var files=test-files :exports output :results raw echo "#+NAME: headers" echo "#+BEGIN_SRC C :tangle no" for file in $files do - routine=${file%.c} - echo "MunitResult ${routine}();" + routine=${file%.c} + echo "MunitResult ${routine}();" done echo "#+END_SRC" -#+END_SRC + #+END_SRC -#+RESULTS: -#+NAME: headers -#+BEGIN_SRC C :tangle no + #+RESULTS: + #+NAME: headers + #+BEGIN_SRC C :tangle no MunitResult test_qmckl_ao(); MunitResult test_qmckl_context(); MunitResult test_qmckl_distance(); MunitResult test_qmckl_memory(); -#+END_SRC + #+END_SRC -and the required function calls: -#+BEGIN_SRC sh :var files=test-files :exports output :results raw + and the required function calls: + #+BEGIN_SRC sh :var files=test-files :exports output :results raw echo "#+NAME: calls" echo "#+BEGIN_SRC C :tangle no" for file in $files do - routine=${file%.c} - echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," + routine=${file%.c} + echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}," done echo "#+END_SRC" -#+END_SRC - -#+RESULTS: -#+NAME: calls -#+BEGIN_SRC C :tangle no + #+END_SRC + + #+RESULTS: + #+NAME: calls + #+BEGIN_SRC C :tangle no { (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, { (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL}, -#+END_SRC + #+END_SRC -#+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c + #+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c #include "qmckl.h" #include "munit.h" <> @@ -78,15 +71,15 @@ echo "#+END_SRC" int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) { static MunitTest test_suite_tests[] = { -<> + <> { NULL, NULL, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL } }; - static const MunitSuite test_suite = + static const MunitSuite test_suite = { (char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE }; - return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); -} -#+END_SRC + return munit_suite_main(&test_suite, (void*) "µnit", argc, argv); + } + #+END_SRC From 69fa53c877fe7f278b3ad455c96c81296afc95ce Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 15:53:28 +0100 Subject: [PATCH 48/61] Modified script for colorized html --- {src => docs}/config.el | 25 ++++--------------------- src/create_doc.sh | 11 +++-------- 2 files changed, 7 insertions(+), 29 deletions(-) rename {src => docs}/config.el (77%) diff --git a/src/config.el b/docs/config.el similarity index 77% rename from src/config.el rename to docs/config.el index 9395d1d..2bf16e4 100755 --- a/src/config.el +++ b/docs/config.el @@ -1,6 +1,8 @@ -(require 'org) -(require 'font-lock) +;; Thanks to Tobias's answer on Emacs Stack Exchange: +;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting +(package-initialize) +(require 'font-lock) (require 'subr-x) ;; for `when-let' (unless (boundp 'maximal-integer) @@ -66,22 +68,3 @@ with class 'color and highest min-color value." (or val 'unspecified))) (advice-add 'face-attribute :override #'my-face-attribute) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Debugging: -(defmacro print-args-and-ret (fun) - "Prepare FUN for printing args and return value." - `(advice-add (quote ,fun) :around - (lambda (oldfun &rest args) - (let ((ret (apply oldfun args))) - (message ,(concat "Calling " (symbol-name fun) " with args %S returns %S.") args ret) - ret)) - '((name "print-args-and-ret")))) - -; (print-args-and-ret htmlize-faces-in-buffer) -; (print-args-and-ret htmlize-get-override-fstruct) -; (print-args-and-ret htmlize-face-to-fstruct) -; (print-args-and-ret htmlize-attrlist-to-fstruct) -; (print-args-and-ret face-foreground) -; (print-args-and-ret face-background) -; (print-args-and-ret face-attribute) diff --git a/src/create_doc.sh b/src/create_doc.sh index 5613c26..ea002d9 100755 --- a/src/create_doc.sh +++ b/src/create_doc.sh @@ -1,13 +1,8 @@ #!/bin/bash INPUT=$1 -#emacs merged_qmckl.org --batch --eval "(require 'htmlize)" -f org-html-export-to-html --kill -emacs \ - $INPUT \ - --batch \ - --eval "(package-initialize)" \ - -f org-html-export-to-html \ - --kill -mv *.html ../docs +emacs --batch --load ../docs/config.el $INPUT -f org-html-export-to-html + +mv index.html ../docs From 5cd333a7cd1c63aeae801e7ece6e7681fbfd9287 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 16:11:54 +0100 Subject: [PATCH 49/61] Update config.el --- docs/config.el | 65 -------------------------------------------------- 1 file changed, 65 deletions(-) diff --git a/docs/config.el b/docs/config.el index 2bf16e4..4986182 100755 --- a/docs/config.el +++ b/docs/config.el @@ -2,69 +2,4 @@ ;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting (package-initialize) -(require 'font-lock) -(require 'subr-x) ;; for `when-let' -(unless (boundp 'maximal-integer) - (defconst maximal-integer (lsh -1 -1) - "Maximal integer value representable natively in emacs lisp.")) - -(defun face-spec-default (spec) - "Get list containing at most the default entry of face SPEC. -Return nil if SPEC has no default entry." - (let* ((first (car-safe spec)) - (display (car-safe first))) - (when (eq display 'default) - (list (car-safe spec))))) - -(defun face-spec-min-color (display-atts) - "Get min-color entry of DISPLAY-ATTS pair from face spec." - (let* ((display (car-safe display-atts))) - (or (car-safe (cdr (assoc 'min-colors display))) - maximal-integer))) - -(defun face-spec-highest-color (spec) - "Search face SPEC for highest color. -That means the DISPLAY entry of SPEC -with class 'color and highest min-color value." - (let ((color-list (cl-remove-if-not - (lambda (display-atts) - (when-let ((display (car-safe display-atts)) - (class (and (listp display) - (assoc 'class display))) - (background (assoc 'background display))) - (and (member 'light (cdr background)) - (member 'color (cdr class))))) - spec))) - (cl-reduce (lambda (display-atts1 display-atts2) - (if (> (face-spec-min-color display-atts1) - (face-spec-min-color display-atts2)) - display-atts1 - display-atts2)) - (cdr color-list) - :initial-value (car color-list)))) - -(defun face-spec-t (spec) - "Search face SPEC for fall back." - (cl-find-if (lambda (display-atts) - (eq (car-safe display-atts) t)) - spec)) - -(defun my-face-attribute (face attribute &optional frame inherit) - "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'." - (let* ((face-spec (face-user-default-spec face)) - (display-attr (or (face-spec-highest-color face-spec) - (face-spec-t face-spec))) - (attr (cdr display-attr)) - (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr)))))) - ;; (message "attribute: %S" attribute) ;; for debugging - (when (and (null (eq attribute :inherit)) - (null val)) - (let ((inherited-face (my-face-attribute face :inherit))) - (when (and inherited-face - (null (eq inherited-face 'unspecified))) - (setq val (my-face-attribute inherited-face attribute))))) - ;; (message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging - (or val 'unspecified))) - -(advice-add 'face-attribute :override #'my-face-attribute) From 74f3cb0e3626ba5faddae5452e3bf635bc50890b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 17:49:59 +0100 Subject: [PATCH 50/61] Update gh-pages.yml --- .github/workflows/gh-pages.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index f686184..3e37812 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -12,7 +12,7 @@ jobs: - uses: actions/checkout@v2 - name: install dependencies - run: sudo apt-get install emacs + run: sudo apt-get install emacs26 - name: make run: make -C src/ doc From b93d162a651192be8a134ab40226dc1a5040210f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Thu, 5 Nov 2020 17:54:58 +0100 Subject: [PATCH 51/61] Update gh-pages.yml --- .github/workflows/gh-pages.yml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 3e37812..cbbe390 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -10,7 +10,13 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 - + + - name: install extra repository + run: sudo add-apt-repository ppa:kelleyk/emacs + + - name: refresh apt + run: sudo apt-get update + - name: install dependencies run: sudo apt-get install emacs26 From abbc12e160e68cb3c02301ab125c6d6b9468cad5 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 6 Nov 2020 10:58:22 +0100 Subject: [PATCH 52/61] Transposed VGL in ao_polynomials --- src/Makefile | 33 +++++++++++++++++++----- src/qmckl_ao.org | 67 +++++++++++++++++++++++++++--------------------- 2 files changed, 64 insertions(+), 36 deletions(-) diff --git a/src/Makefile b/src/Makefile index 28de44e..295b783 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,3 +1,8 @@ +COMPILER=GNU +#COMPILER=INTEL +#COMPILER=LLVM + +ifeq($(COMPILER),GNU) CC=gcc -g CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra @@ -5,14 +10,28 @@ FC=gfortran -g FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan LIBS=-lgfortran -lm +endif -#CC=icc -xHost -#CFLAGS=-fPIC -g -O2 -# -#FC=ifort -xHost -#FFLAGS=-fPIC -g -O2 -# -#LIBS=-lm -lifcore -lirc +ifeq($(COMPILER),INTEL) +CC=icc -xHost +CFLAGS=-fPIC -g -O2 + +FC=ifort -xHost +FFLAGS=-fPIC -g -O2 + +LIBS=-lm -lifcore -lirc +endif + +#TODO +ifeq($(COMPILER),LLVM) +CC=clang +CFLAGS=-fPIC -g -O2 + +FC=flang +FFLAGS=fPIC -g -O2 + +LIBS=-lm +endif export CC CFLAGS FC FFLAGS LIBS diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 506beb8..fbf97b7 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -205,7 +205,7 @@ munit_assert_int(0, ==, test_qmckl_ao_powers(context)); | =n= | output | Number of computed polynomials | | =L(ldl,n)= | output | Contains a,b,c for all =n= results | | =ldl= | input | Leading dimension of =L= | - | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials | + | =VGL(ldv,n)= | output | Value, gradients and Laplacian of the polynomials | | =ldv= | input | Leading dimension of array =VGL= | ***** Requirements @@ -214,12 +214,25 @@ munit_assert_int(0, ==, test_qmckl_ao_powers(context)); - =n= > 0 - =lmax= >= 0 - =ldl= >= 3 - - =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 + - =ldv= >= 5 - =X= is allocated with at least $3 \times 8$ bytes - =R= is allocated with at least $3 \times 8$ bytes + - =n= >= =(lmax+1)(lmax+2)(lmax+3)/6= - =L= is allocated with at least $3 \times n \times 4$ bytes - - =VGL= is allocated with at least $n \times 5 \times 8$ bytes - - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 + - =VGL= is allocated with at least $5 \times n \times 8$ bytes + - On output, =n= should be equal to =(lmax+1)(lmax+2)(lmax+3)/6= + - On output, the powers are given in the following order (l=a+b+c): + - Increase values of =l= + - Within a given value of =l=, alphabetical order of the + string made by a*"x" + b*"y" + c*"z" (in Python notation). + For example, with a=0, b=2 and c=1 the string is "yyz" + +***** Error codes + + | -1 | Null context | + | -2 | Inconsistent =ldl= | + | -3 | Inconsistent =ldv= | + | -4 | Inconsistent =lmax= | ***** Header #+BEGIN_SRC C :tangle qmckl.h @@ -240,7 +253,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, integer*8 , intent(out) :: n integer , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) integer*8 , intent(in) :: ldl - real*8 , intent(out) :: VGL(ldv,5) + real*8 , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) integer*8 , intent(in) :: ldv integer*8 :: i,j @@ -264,7 +277,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, return endif - if (ldv < (lmax+1)*(lmax+2)*(lmax+3)/6) then + if (ldv < 5) then info = -3 return endif @@ -289,8 +302,8 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, if (info /= 0) return - vgl(1,1) = 1.d0 - vgl(1,2:5) = 0.d0 + VGL(1,1) = 1.d0 + vgL(2:5,1) = 0.d0 l(1:3,1) = 0 n=1 dd = 1.d0 @@ -310,17 +323,17 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, yz = pows(b,2) * pows(c,3) xz = pows(a,1) * pows(c,3) - vgl(n,1) = xy * pows(c,3) + vgl(1,n) = xy * pows(c,3) xy = dc * xy xz = db * xz yz = da * yz - vgl(n,2) = pows(a-1,1) * yz - vgl(n,3) = pows(b-1,2) * xz - vgl(n,4) = pows(c-1,3) * xy + vgl(2,n) = pows(a-1,1) * yz + vgl(3,n) = pows(b-1,2) * xz + vgl(4,n) = pows(c-1,3) * xy - vgl(n,5) = & + vgl(5,n) = & (da-1.d0) * pows(a-2,1) * yz + & (db-1.d0) * pows(b-2,2) * xz + & (dc-1.d0) * pows(c-2,3) * xy @@ -332,11 +345,6 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, dd = dd + 1.d0 end do - if (n /= (lmax+1)*(lmax+2)*(lmax+3)/6) then - info = -5 - return - endif - info = 0 end function qmckl_ao_polynomial_vgl_f @@ -354,7 +362,7 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l integer (c_int64_t) , intent(out) :: n integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) integer (c_int64_t) , intent(in) , value :: ldl - real (c_double) , intent(out) :: VGL(ldv,5) + real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) integer (c_int64_t) , intent(in) , value :: ldv integer, external :: qmckl_ao_polynomial_vgl_f @@ -362,6 +370,7 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l end function qmckl_ao_polynomial_vgl #+END_SRC +***** Fortran interface :noexport: #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & @@ -374,7 +383,7 @@ end function qmckl_ao_polynomial_vgl real (c_double) , intent(in) :: X(3), R(3) integer (c_int64_t) , intent(out) :: n integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6) - real (c_double) , intent(out) :: VGL(ldv,5) + real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6) end function qmckl_ao_polynomial_vgl end interface #+END_SRC @@ -407,7 +416,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) d = (lmax+1)*(lmax+2)*(lmax+3)/6 - allocate (L(ldl,100), VGL(ldv,5)) + allocate (L(ldl,d), VGL(ldv,d)) test_qmckl_ao_polynomial_vgl = & qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) @@ -423,33 +432,33 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) if (L(i,j) < 0) return end do test_qmckl_ao_polynomial_vgl = -12 - if (dabs(1.d0 - VGL(j,1) / (& + if (dabs(1.d0 - VGL(1,j) / (& Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**L(3,j) & )) > epsilon ) return test_qmckl_ao_polynomial_vgl = -13 if (L(1,j) < 1) then - if (VGL(j,2) /= 0.d0) return + if (VGL(2,j) /= 0.d0) return else - if (dabs(1.d0 - VGL(j,2) / (& + if (dabs(1.d0 - VGL(2,j) / (& L(1,j) * Y(1)**(L(1,j)-1) * Y(2)**L(2,j) * Y(3)**L(3,j) & )) > epsilon ) return end if test_qmckl_ao_polynomial_vgl = -14 if (L(2,j) < 1) then - if (VGL(j,3) /= 0.d0) return + if (VGL(3,j) /= 0.d0) return else - if (dabs(1.d0 - VGL(j,3) / (& + if (dabs(1.d0 - VGL(3,j) / (& L(2,j) * Y(1)**L(1,j) * Y(2)**(L(2,j)-1) * Y(3)**L(3,j) & )) > epsilon ) return end if test_qmckl_ao_polynomial_vgl = -15 if (L(3,j) < 1) then - if (VGL(j,4) /= 0.d0) return + if (VGL(4,j) /= 0.d0) return else - if (dabs(1.d0 - VGL(j,4) / (& + if (dabs(1.d0 - VGL(4,j) / (& L(3,j) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-1) & )) > epsilon ) return end if @@ -465,7 +474,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) if (L(3,j) > 1) then w = w + L(3,j) * (L(3,j)-1) * Y(1)**L(1,j) * Y(2)**L(2,j) * Y(3)**(L(3,j)-2) end if - if (dabs(1.d0 - VGL(j,5) / w) > epsilon ) return + if (dabs(1.d0 - VGL(5,j) / w) > epsilon ) return end do test_qmckl_ao_polynomial_vgl = 0 From 3852dad53d56b7ad0c8810c5f899ae49087b8d5c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 6 Nov 2020 12:10:20 +0100 Subject: [PATCH 53/61] Reordering of powers in polynomials --- src/Makefile | 6 +++--- src/qmckl.org | 1 + src/qmckl_ao.org | 15 +++++++-------- src/qmckl_context.org | 4 ++-- src/qmckl_distance.org | 1 - 5 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/Makefile b/src/Makefile index 295b783..7f78a9b 100644 --- a/src/Makefile +++ b/src/Makefile @@ -2,7 +2,7 @@ COMPILER=GNU #COMPILER=INTEL #COMPILER=LLVM -ifeq($(COMPILER),GNU) +ifeq ($(COMPILER),GNU) CC=gcc -g CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra @@ -12,7 +12,7 @@ FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wint LIBS=-lgfortran -lm endif -ifeq($(COMPILER),INTEL) +ifeq ($(COMPILER),INTEL) CC=icc -xHost CFLAGS=-fPIC -g -O2 @@ -23,7 +23,7 @@ LIBS=-lm -lifcore -lirc endif #TODO -ifeq($(COMPILER),LLVM) +ifeq ($(COMPILER),LLVM) CC=clang CFLAGS=-fPIC -g -O2 diff --git a/src/qmckl.org b/src/qmckl.org index 7620883..ce5a3ce 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -12,6 +12,7 @@ #define QMCKL_H #include #include +#include #+END_SRC #+BEGIN_SRC f90 :tangle qmckl_f.f90 diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index fbf97b7..4371cd9 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -11,7 +11,6 @@ *** Test :noexport: #+BEGIN_SRC C :tangle test_qmckl_ao.c -#include #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_ao() { @@ -308,10 +307,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, n=1 dd = 1.d0 do d=1,lmax - da = 0.d0 - do a=0,d - db = 0.d0 - do b=0,d-a + da = dd + do a=d,0,-1 + db = dd-da + do b=d-a,0,-1 c = d - a - b dc = dd - da - db n = n+1 @@ -338,9 +337,9 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, (db-1.d0) * pows(b-2,2) * xz + & (dc-1.d0) * pows(c-2,3) * xy - db = db + 1.d0 + db = db - 1.d0 end do - da = da + 1.d0 + da = da - 1.d0 end do dd = dd + 1.d0 end do @@ -413,7 +412,7 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) n = 0; ldl = 3; ldv = 100; - + d = (lmax+1)*(lmax+2)*(lmax+3)/6 allocate (L(ldl,d), VGL(ldv,d)) diff --git a/src/qmckl_context.org b/src/qmckl_context.org index e407466..5359470 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -461,7 +461,7 @@ int qmckl_context_get_range(const qmckl_context context) { ***** TODO Tests :noexport: **** =qmckl_context_get_epsilon= - Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision + Returns $\epsilon = 2^{1-n}$ where =n= is the precision #+BEGIN_SRC C :comments org :tangle qmckl.h double qmckl_context_get_epsilon(const qmckl_context context); #+END_SRC @@ -470,7 +470,7 @@ double qmckl_context_get_epsilon(const qmckl_context context); #+BEGIN_SRC C :tangle qmckl_context.c double qmckl_context_get_epsilon(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return 1.0 / ((double) ((int64_t) 1 << (ctx->precision-1))); + return pow(2.0,(double) 1-ctx->precision); } #+END_SRC diff --git a/src/qmckl_distance.org b/src/qmckl_distance.org index 06c8015..5eac91d 100644 --- a/src/qmckl_distance.org +++ b/src/qmckl_distance.org @@ -9,7 +9,6 @@ **** Headers :noexport: #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c -#include #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_distance() { From 7e3d259c9d39f11a3acf124e68876375042b5caa Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 7 Nov 2020 15:41:49 +0100 Subject: [PATCH 54/61] Added emacs config file --- docs/config.el | 65 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 65 insertions(+) diff --git a/docs/config.el b/docs/config.el index 4986182..2bf16e4 100755 --- a/docs/config.el +++ b/docs/config.el @@ -2,4 +2,69 @@ ;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting (package-initialize) +(require 'font-lock) +(require 'subr-x) ;; for `when-let' +(unless (boundp 'maximal-integer) + (defconst maximal-integer (lsh -1 -1) + "Maximal integer value representable natively in emacs lisp.")) + +(defun face-spec-default (spec) + "Get list containing at most the default entry of face SPEC. +Return nil if SPEC has no default entry." + (let* ((first (car-safe spec)) + (display (car-safe first))) + (when (eq display 'default) + (list (car-safe spec))))) + +(defun face-spec-min-color (display-atts) + "Get min-color entry of DISPLAY-ATTS pair from face spec." + (let* ((display (car-safe display-atts))) + (or (car-safe (cdr (assoc 'min-colors display))) + maximal-integer))) + +(defun face-spec-highest-color (spec) + "Search face SPEC for highest color. +That means the DISPLAY entry of SPEC +with class 'color and highest min-color value." + (let ((color-list (cl-remove-if-not + (lambda (display-atts) + (when-let ((display (car-safe display-atts)) + (class (and (listp display) + (assoc 'class display))) + (background (assoc 'background display))) + (and (member 'light (cdr background)) + (member 'color (cdr class))))) + spec))) + (cl-reduce (lambda (display-atts1 display-atts2) + (if (> (face-spec-min-color display-atts1) + (face-spec-min-color display-atts2)) + display-atts1 + display-atts2)) + (cdr color-list) + :initial-value (car color-list)))) + +(defun face-spec-t (spec) + "Search face SPEC for fall back." + (cl-find-if (lambda (display-atts) + (eq (car-safe display-atts) t)) + spec)) + +(defun my-face-attribute (face attribute &optional frame inherit) + "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'." + (let* ((face-spec (face-user-default-spec face)) + (display-attr (or (face-spec-highest-color face-spec) + (face-spec-t face-spec))) + (attr (cdr display-attr)) + (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr)))))) + ;; (message "attribute: %S" attribute) ;; for debugging + (when (and (null (eq attribute :inherit)) + (null val)) + (let ((inherited-face (my-face-attribute face :inherit))) + (when (and inherited-face + (null (eq inherited-face 'unspecified))) + (setq val (my-face-attribute inherited-face attribute))))) + ;; (message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging + (or val 'unspecified))) + +(advice-add 'face-attribute :override #'my-face-attribute) From 352679919e1331a28758e66b75a1fb854c8935c9 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 7 Nov 2020 16:11:34 +0100 Subject: [PATCH 55/61] Fix GH workflow --- .github/workflows/gh-pages.yml | 12 +++++++++--- docs/config.el | 1 + src/create_doc.sh | 7 ++++++- 3 files changed, 16 insertions(+), 4 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index cbbe390..911bef1 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -10,16 +10,22 @@ jobs: runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 - + - name: install extra repository run: sudo add-apt-repository ppa:kelleyk/emacs - + - name: refresh apt run: sudo apt-get update - + - name: install dependencies run: sudo apt-get install emacs26 + - name: install htmlize + run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el src/ + + - name: install htmlize + run: git clone https://github.com/hniksic/emacs-htmlize + - name: make run: make -C src/ doc diff --git a/docs/config.el b/docs/config.el index 2bf16e4..093ee8c 100755 --- a/docs/config.el +++ b/docs/config.el @@ -2,6 +2,7 @@ ;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting (package-initialize) +(require 'htmlize) (require 'font-lock) (require 'subr-x) ;; for `when-let' diff --git a/src/create_doc.sh b/src/create_doc.sh index ea002d9..39327c8 100755 --- a/src/create_doc.sh +++ b/src/create_doc.sh @@ -1,7 +1,12 @@ #!/bin/bash INPUT=$1 -emacs --batch --load ../docs/config.el $INPUT -f org-html-export-to-html +if [[ -f ../docs/htmlize.el ]] +then + emacs --batch --load ../docs/htmlize.el --load ../docs/config.el $INPUT -f org-html-export-to-html +else + emacs --batch --load ../docs/config.el $INPUT -f org-html-export-to-html +fi mv index.html ../docs From f10b6336793f789308a0a999a24994c3ae166742 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 7 Nov 2020 16:12:47 +0100 Subject: [PATCH 56/61] Fix GH workflow --- .github/workflows/gh-pages.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 911bef1..c45ae33 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -21,10 +21,10 @@ jobs: run: sudo apt-get install emacs26 - name: install htmlize - run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el src/ + run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el src/ - name: install htmlize - run: git clone https://github.com/hniksic/emacs-htmlize + run: git clone https://github.com/hniksic/emacs-htmlize - name: make run: make -C src/ doc From 22e0936a635c7f605929d2ed31ec6106429ed5c8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 7 Nov 2020 16:13:58 +0100 Subject: [PATCH 57/61] Fix GH workflow --- .github/workflows/gh-pages.yml | 3 --- 1 file changed, 3 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index c45ae33..f403819 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -23,9 +23,6 @@ jobs: - name: install htmlize run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el src/ - - name: install htmlize - run: git clone https://github.com/hniksic/emacs-htmlize - - name: make run: make -C src/ doc From 8a53306a6332840a4f38e0a80747526a11997ee4 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 7 Nov 2020 16:17:37 +0100 Subject: [PATCH 58/61] Fix GH workflow --- .github/workflows/gh-pages.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index f403819..45b9ebe 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -21,7 +21,7 @@ jobs: run: sudo apt-get install emacs26 - name: install htmlize - run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el src/ + run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el docs/ - name: make run: make -C src/ doc From d50737687c451b88367d25d7af55a2e090deb452 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 7 Nov 2020 16:32:23 +0100 Subject: [PATCH 59/61] Inline function in polynomials --- src/qmckl_ao.org | 52 +++++++++++++++++++++++++++++++++++------------- 1 file changed, 38 insertions(+), 14 deletions(-) diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 4371cd9..51736d9 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -290,23 +290,46 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, do i=1,3 Y(i) = X(i) - R(i) end do - pows(-2:-1,1:3) = 0.d0 - pows(0,1:3) = 1.d0 + lmax_array(1:3) = lmax - info = qmckl_ao_powers_f(context, 1_8, Y(1), (/lmax/), pows(1,1), size(pows,1,kind=8)) - if (info /= 0) return - info = qmckl_ao_powers_f(context, 1_8, Y(2), (/lmax/), pows(1,2), size(pows,1,kind=8)) - if (info /= 0) return - info = qmckl_ao_powers_f(context, 1_8, Y(3), (/lmax/), pows(1,3), size(pows,1,kind=8)) - if (info /= 0) return + if (lmax == 0) then + VGL(1,1) = 1.d0 + vgL(2:5,1) = 0.d0 + l(1:3,1) = 0 + n=1 + else if (lmax > 0) then + pows(-2:0,1:3) = 1.d0 + do i=1,lmax + pows(i,1) = pows(i-1,1) * Y(1) + pows(i,2) = pows(i-1,2) * Y(2) + pows(i,3) = pows(i-1,3) * Y(3) + end do - VGL(1,1) = 1.d0 - vgL(2:5,1) = 0.d0 - l(1:3,1) = 0 - n=1 - dd = 1.d0 - do d=1,lmax + VGL(1:5,1:4) = 0.d0 + l(1:3,1:4) = 0 + + VGL(1,1) = 1.d0 + vgl(1:5,2:4) = 0.d0 + + l(1,2) = 1 + vgl(1,2) = pows(1,1) + vgL(2,2) = 1.d0 + + l(2,3) = 1 + vgl(1,3) = pows(1,2) + vgL(3,3) = 1.d0 + + l(3,4) = 1 + vgl(1,4) = pows(1,3) + vgL(4,4) = 1.d0 + + n=4 + endif + + ! l>=2 + dd = 2.d0 + do d=2,lmax da = dd do a=d,0,-1 db = dd-da @@ -314,6 +337,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, c = d - a - b dc = dd - da - db n = n+1 + l(1,n) = a l(2,n) = b l(3,n) = c From 6b797bd5d414e00723e26109ea854dfdae227e6a Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 14 Nov 2020 18:27:38 +0100 Subject: [PATCH 60/61] Added AO basis in context. Tests to do --- src/README.org | 188 +++++++++++---------- src/qmckl_ao.org | 106 ++++++------ src/qmckl_context.org | 380 ++++++++++++++++++++++++++++++++++++++---- 3 files changed, 494 insertions(+), 180 deletions(-) diff --git a/src/README.org b/src/README.org index 7ea4694..abe0663 100644 --- a/src/README.org +++ b/src/README.org @@ -1,58 +1,53 @@ #+TITLE: QMCkl source code documentation #+EXPORT_FILE_NAME: index.html -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: -#+HTML_HEAD: +#+SETUPFILE: https://fniessen.github.io/org-html-themes/setup/theme-readtheorg.setup * Introduction - The ultimate goal of QMCkl is to provide a high-performance - implementation of the main kernels of QMC. In this particular - repository, we focus on the definition of the API and the tests, - and on a /pedagogical/ presentation of the algorithms. We expect the - HPC experts to use this repository as a reference for re-writing + The ultimate goal of QMCkl is to provide a high-performance + implementation of the main kernels of QMC. In this particular + repository, we focus on the definition of the API and the tests, and + on a /pedagogical/ presentation of the algorithms. We expect the + HPC experts to use this repository as a reference for re-writing optimized libraries. - Literate programming is particularly adapted in this context. - Source files are written in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, to provide useful + Literate programming is particularly adapted in this context. + Source files are written in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format, to provide useful comments and LaTex formulas close to the code. There exists multiple - possibilities to convert org-mode files into different formats such as - HTML or pdf. - For a tutorial on literate programming with org-mode, follow - [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. + possibilities to convert org-mode files into different formats such + as HTML or pdf. For a tutorial on literate programming with + org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. - The code is extracted from the org files using Emacs as a command-line - tool in the =Makefile=, and then the produced files are compiled. + The code is extracted from the org files using Emacs as a + command-line tool in the =Makefile=, and then the produced files are + compiled. ** Language used - Fortran is one of the most common languages used by the community, - and is simple enough to make the algorithms readable. Hence we - propose in this pedagogical implementation of QMCkl to use Fortran - to express the algorithms. For specific internal functions where + Fortran is one of the most common languages used by the community, + and is simple enough to make the algorithms readable. Hence we + propose in this pedagogical implementation of QMCkl to use Fortran + to express the algorithms. For specific internal functions where the C language is more natural, C is used. - As Fortran modules generate compiler-dependent files, the use of + As Fortran modules generate compiler-dependent files, the use of modules is restricted to the internal use of the library, otherwise the compliance with C is violated. - The external dependencies should be kept as small as possible, so - external libraries should be used /only/ if their used is strongly + The external dependencies should be kept as small as possible, so + external libraries should be used /only/ if their used is strongly justified. ** Source code editing - Any text editor can be used to edit org-mode files. For a better - user experience Emacs is recommended. - For users hating Emacs, it is good to know that Emacs can behave - like Vim when switched into ``Evil'' mode. There also exists - [[https://www.spacemacs.org][Spacemacs]] which helps the transition for Vim users. + Any text editor can be used to edit org-mode files. For a better + user experience Emacs is recommended. For users hating Emacs, it + is good to know that Emacs can behave like Vim when switched into + ``Evil'' mode. There also exists [[https://www.spacemacs.org][Spacemacs]] which helps the + transition for Vim users. - For users with a preference for Jupyter notebooks, the following + For users with a preference for Jupyter notebooks, the following script can convert jupyter notebooks to org-mode files: #+BEGIN_SRC sh tangle: nb_to_org.sh @@ -72,24 +67,25 @@ rm ${nb}.md ** Writing in Fortran - The Fortran source files should provide a C interface using - =iso_c_binding=. The name of the Fortran source files should end - with =_f.f90= to be properly handled by the Makefile. - The names of the functions defined in fortran should be the same as - those exposed in the API suffixed by =_f=. - Fortran interface files should also be written in a file with a - =.fh= extension. + The Fortran source files should provide a C interface using + =iso_c_binding=. The name of the Fortran source files should end + with =_f.f90= to be properly handled by the Makefile. The names of + the functions defined in fortran should be the same as those + exposed in the API suffixed by =_f=. Fortran interface files + should also be written in the =qmckl_f.f90= file. For more guidelines on using Fortran to generate a C interface, see - [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]] + [[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]]. ** Coding style # TODO: decide on a coding style - To improve readability, we maintain a consistent coding style in the library. + To improve readability, we maintain a consistent coding style in + the library. - - For C source files, we will use __(decide on a coding style)__ - - For Fortran source files, we will use __(decide on a coding style)__ + - For C source files, we will use __(decide on a coding style)__ + - For Fortran source files, we will use __(decide on a coding + style)__ Coding style can be automatically checked with [[https://clang.llvm.org/docs/ClangFormat.html][clang-format]]. @@ -99,103 +95,105 @@ rm ${nb}.md - deal with memory transfers between CPU and accelerators - use different levels of floating-point precision - We chose a multi-layered design with low-level and high-level + We chose a multi-layered design with low-level and high-level functions (see below). *** Naming conventions Use =qmckl_= as a prefix for all exported functions and variables. - All exported header files should have a filename with the prefix + All exported header files should have a filename with the prefix =qmckl_=. - If the name of the org-mode file is =xxx.org=, the name of the + If the name of the org-mode file is =xxx.org=, the name of the produced C files should be =xxx.c= and =xxx.h= and the name of the produced Fortran files should be =xxx.f90= Arrays are in uppercase and scalars are in lowercase. + + In the names of the variables and functions, only the singular + form is allowed. *** Application programming interface - The application programming interface (API) is designed to be - compatible with the C programming language (not C++), to ensure - that the library will be easily usable in any language. - This implies that only the following data types are allowed in the API: + The application programming interface (API) is designed to be + compatible with the C programming language (not C++), to ensure + that the library will be easily usable in /any/ language. This + implies that only the following data types are allowed in the API: - 32-bit and 64-bit floats and arrays (=real= and =double=) - 32-bit and 64-bit integers and arrays (=int32_t= and =int64_t=) - - Pointers should be represented as 64-bit integers (even on + - Pointers should be represented as 64-bit integers (even on 32-bit architectures) - - ASCII strings are represented as a pointers to a character arrays - and terminated by a zero character (C convention). + - ASCII strings are represented as a pointers to a character + arrays and terminated by a zero character (C convention). Complex numbers can be represented by an array of 2 floats. # TODO : Link to repositories for bindings - To facilitate the use in other languages than C, we provide some + To facilitate the use in other languages than C, we provide some bindings in other languages in other repositories. *** Global state - Global variables should be avoided in the library, because it is - possible that one single program needs to use multiple instances of - the library. To solve this problem we propose to use a pointer to a - =context= variable, built by the library with the + Global variables should be avoided in the library, because it is + possible that one single program needs to use multiple instances + of the library. To solve this problem we propose to use a pointer + to a =context= variable, built by the library with the =qmckl_context_create= function. The =context= contains the global - state of the library, and is used as the first argument of many + state of the library, and is used as the first argument of many QMCkl functions. - Modifying the state is done by setters and getters, prefixed - by =qmckl_context_set_= an =qmckl_context_get_=. - When a context variable is modified by a setter, a copy of the old - data structure is made and updated, and the pointer to the new data - structure is returned, such that the old contexts can still be - accessed. - It is also possible to modify the state in an impure fashion, using - the =qmckl_context_update_= functions. - The context and its old versions can be destroyed with - =qmckl_context_destroy=. + The internal structure of the context is not specified, to give a + maximum of freedom to the different implementations. Modifying + the state is done by setters and getters, prefixed by + =qmckl_context_set_= an =qmckl_context_get_=. When a context + variable is modified by a setter, a copy of the old data structure + is made and updated, and the pointer to the new data structure is + returned, such that the old contexts can still be accessed. It is + also possible to modify the state in an impure fashion, using the + =qmckl_context_update_= functions. The context and its old + versions can be destroyed with =qmckl_context_destroy=. *** Low-level functions - Low-level functions are very simple functions which are leaves of the - function call tree (they don't call any other QMCkl function). + Low-level functions are very simple functions which are leaves of + the function call tree (they don't call any other QMCkl function). - This functions are /pure/, and unaware of the QMCkl =context=. They are - not allowed to allocate/deallocate memory, and if they need - temporary memory it should be provided in input. + These functions are /pure/, and unaware of the QMCkl + =context=. They are not allowed to allocate/deallocate memory, and + if they need temporary memory it should be provided in input. *** High-level functions - High-level functions are at the top of the function call tree. - They are able to choose which lower-level function to call + High-level functions are at the top of the function call tree. + They are able to choose which lower-level function to call depending on the required precision, and do the corresponding type - conversions. - These functions are also responsible for allocating temporary - storage, to simplify the use of accelerators. + conversions. These functions are also responsible for allocating + temporary storage, to simplify the use of accelerators. - The high-level functions should be pure, unless the introduction of - non-purity is justified. All the side effects should be made in the - =context= variable. + The high-level functions should be pure, unless the introduction + of non-purity is justified. All the side effects should be made in + the =context= variable. # TODO : We need an identifier for impure functions *** Numerical precision - The number of bits of precision required for a function should be - given as an input of low-level computational functions. This input will - be used to define the values of the different thresholds that might - be used to avoid computing unnecessary noise. - High-level functions will use the precision specified in the - =context= variable. + The number of bits of precision required for a function should be + given as an input of low-level computational functions. This input + will be used to define the values of the different thresholds that + might be used to avoid computing unnecessary noise. High-level + functions will use the precision specified in the =context= + variable. ** Algorithms - Reducing the scaling of an algorithm usually implies also reducing - its arithmetic complexity (number of flops per byte). Therefore, - for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) algorithms - are better adapted than linear scaling algorithms. - As QMCkl is a general purpose library, multiple algorithms should - be implemented adapted to different problem sizes. + Reducing the scaling of an algorithm usually implies also reducing + its arithmetic complexity (number of flops per byte). Therefore, + for small sizes \(\mathcal{O}(N^3)\) and \(\mathcal{O}(N^2)\) + algorithms are better adapted than linear scaling algorithms. As + QMCkl is a general purpose library, multiple algorithms should be + implemented adapted to different problem sizes. ** Rules for the API @@ -206,4 +204,4 @@ rm ${nb}.md * Documentation - + diff --git a/src/qmckl_ao.org b/src/qmckl_ao.org index 506beb8..13d28ee 100644 --- a/src/qmckl_ao.org +++ b/src/qmckl_ao.org @@ -1,7 +1,7 @@ ** Atomic Orbitals - This files contains all the routines for the computation of the + This files contains all the routines for the computation of the values, gradients and Laplacian of the atomic basis functions. 3 files are produced: @@ -25,9 +25,12 @@ MunitResult test_qmckl_ao() { P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c \] \begin{eqnarray*} - \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ - \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ - \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ + \frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\ + \frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\ + \frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & + = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\ \end{eqnarray*} \begin{eqnarray*} \left( \frac{\partial }{\partial x^2} + @@ -39,9 +42,9 @@ MunitResult test_qmckl_ao() { && c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \end{eqnarray*} -**** =qmckl_ao_powers= +**** =qmckl_ao_power= - Computes all the powers of the =n= input data up to the given + Computes all the powers of the =n= input data up to the given maximum value given in input for each of the $n$ points: \[ P_{ij} = X_j^i \] @@ -66,7 +69,7 @@ MunitResult test_qmckl_ao() { ***** Header #+BEGIN_SRC C :tangle qmckl.h -qmckl_exit_code qmckl_ao_powers(const qmckl_context context, +qmckl_exit_code qmckl_ao_power(const qmckl_context context, const int64_t n, const double *X, const int32_t *LMAX, const double *P, const int64_t LDP); @@ -74,7 +77,7 @@ qmckl_exit_code qmckl_ao_powers(const qmckl_context context, ***** Source #+BEGIN_SRC f90 :tangle qmckl_ao.f90 -integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) +integer function qmckl_ao_power_f(context, n, X, LMAX, P, ldp) result(info) implicit none integer*8 , intent(in) :: context integer*8 , intent(in) :: n @@ -104,12 +107,12 @@ integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) end do end do -end function qmckl_ao_powers_f +end function qmckl_ao_power_f #+END_SRC ***** C interface :noexport: #+BEGIN_SRC f90 :tangle qmckl_ao.f90 -integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & +integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) & bind(C) result(info) use, intrinsic :: iso_c_binding implicit none @@ -120,14 +123,14 @@ integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & real (c_double) , intent(out) :: P(ldp,n) integer (c_int64_t) , intent(in) , value :: ldp - integer, external :: qmckl_ao_powers_f - info = qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) -end function qmckl_ao_powers + integer, external :: qmckl_ao_power_f + info = qmckl_ao_power_f(context, n, X, LMAX, P, ldp) +end function qmckl_ao_power #+END_SRC #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface - integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) bind(C) + integer(c_int32_t) function qmckl_ao_power(context, n, X, LMAX, P, ldp) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t) , intent(in) , value :: context integer (c_int64_t) , intent(in) , value :: n @@ -135,13 +138,13 @@ end function qmckl_ao_powers real (c_double) , intent(in) :: X(n) integer (c_int32_t) , intent(in) :: LMAX(n) real (c_double) , intent(out) :: P(ldp,n) - end function qmckl_ao_powers + end function qmckl_ao_power end interface #+END_SRC ***** Test :noexport: #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 -integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) +integer(c_int32_t) function test_qmckl_ao_power(context) bind(C) use qmckl implicit none @@ -165,10 +168,10 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) LMAX(j) = 1 + int(mod(j, 5),4) end do - test_qmckl_ao_powers = qmckl_ao_powers(context, n, X, LMAX, P, LDP) - if (test_qmckl_ao_powers /= 0) return + test_qmckl_ao_power = qmckl_ao_power(context, n, X, LMAX, P, LDP) + if (test_qmckl_ao_power /= 0) return - test_qmckl_ao_powers = -1 + test_qmckl_ao_power = -1 do j=1,n do i=1,LMAX(j) @@ -180,14 +183,14 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) end do end do - test_qmckl_ao_powers = 0 + test_qmckl_ao_power = 0 deallocate(X,P,LMAX) -end function test_qmckl_ao_powers +end function test_qmckl_ao_power #+END_SRC #+BEGIN_SRC C :tangle test_qmckl_ao.c -int test_qmckl_ao_powers(qmckl_context context); -munit_assert_int(0, ==, test_qmckl_ao_powers(context)); +int test_qmckl_ao_power(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_ao_power(context)); #+END_SRC @@ -248,7 +251,7 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, real*8 :: Y(3) integer :: lmax_array(3) real*8 :: pows(-2:lmax,3) - integer, external :: qmckl_ao_powers_f + integer, external :: qmckl_ao_power_f double precision :: xy, yz, xz double precision :: da, db, dc, dd @@ -281,11 +284,11 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, pows(-2:-1,1:3) = 0.d0 pows(0,1:3) = 1.d0 lmax_array(1:3) = lmax - info = qmckl_ao_powers_f(context, 1_8, Y(1), (/lmax/), pows(1,1), size(pows,1,kind=8)) + info = qmckl_ao_power_f(context, 1_8, Y(1), (/lmax/), pows(1,1), size(pows,1,kind=8)) if (info /= 0) return - info = qmckl_ao_powers_f(context, 1_8, Y(2), (/lmax/), pows(1,2), size(pows,1,kind=8)) + info = qmckl_ao_power_f(context, 1_8, Y(2), (/lmax/), pows(1,2), size(pows,1,kind=8)) if (info /= 0) return - info = qmckl_ao_powers_f(context, 1_8, Y(3), (/lmax/), pows(1,3), size(pows,1,kind=8)) + info = qmckl_ao_power_f(context, 1_8, Y(3), (/lmax/), pows(1,3), size(pows,1,kind=8)) if (info /= 0) return @@ -482,7 +485,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); *** Gaussian basis functions -**** =qmckl_ao_gaussians_vgl= +**** =qmckl_ao_gaussian_vgl= Computes the values, gradients and Laplacians at a given point of =n= Gaussian functions centered at the same point: @@ -516,7 +519,7 @@ munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); ***** Header #+BEGIN_SRC C :tangle qmckl.h -qmckl_exit_code qmckl_ao_gaussians_vgl(const qmckl_context context, +qmckl_exit_code qmckl_ao_gaussian_vgl(const qmckl_context context, const double *X, const double *R, const int64_t *n, const int64_t *A, const double *VGL, const int64_t ldv); @@ -524,7 +527,7 @@ qmckl_exit_code qmckl_ao_gaussians_vgl(const qmckl_context context, ***** Source #+BEGIN_SRC f90 :tangle qmckl_ao.f90 -integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result(info) +integer function qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) result(info) implicit none integer*8 , intent(in) :: context real*8 , intent(in) :: X(3), R(3) @@ -582,12 +585,12 @@ integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result( VGL(i,5) = (t * A(i) - 6.d0) * VGL(i,5) end do -end function qmckl_ao_gaussians_vgl_f +end function qmckl_ao_gaussian_vgl_f #+END_SRC ***** C interface :noexport: #+BEGIN_SRC f90 :tangle qmckl_ao.f90 -integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & +integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) result(info) use, intrinsic :: iso_c_binding implicit none @@ -598,14 +601,14 @@ integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv real (c_double) , intent(out) :: VGL(ldv,5) integer (c_int64_t) , intent(in) , value :: ldv - integer, external :: qmckl_ao_gaussians_vgl_f - info = qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) -end function qmckl_ao_gaussians_vgl + integer, external :: qmckl_ao_gaussian_vgl_f + info = qmckl_ao_gaussian_vgl_f(context, X, R, n, A, VGL, ldv) +end function qmckl_ao_gaussian_vgl #+END_SRC #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface - integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & + integer(c_int32_t) function qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) & bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t) , intent(in) , value :: context @@ -613,12 +616,12 @@ end function qmckl_ao_gaussians_vgl integer (c_int64_t) , intent(in) , value :: n real (c_double) , intent(in) :: X(3), R(3), A(n) real (c_double) , intent(out) :: VGL(ldv,5) - end function qmckl_ao_gaussians_vgl + end function qmckl_ao_gaussian_vgl end interface #+END_SRC ***** Test :noexport: #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90 -integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) +integer(c_int32_t) function test_qmckl_ao_gaussian_vgl(context) bind(C) use qmckl implicit none @@ -645,49 +648,48 @@ integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) end do - test_qmckl_ao_gaussians_vgl = & - qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) - if (test_qmckl_ao_gaussians_vgl /= 0) return + test_qmckl_ao_gaussian_vgl = & + qmckl_ao_gaussian_vgl(context, X, R, n, A, VGL, ldv) + if (test_qmckl_ao_gaussian_vgl /= 0) return - test_qmckl_ao_gaussians_vgl = -1 + test_qmckl_ao_gaussian_vgl = -1 do i=1,n - test_qmckl_ao_gaussians_vgl = -11 + test_qmckl_ao_gaussian_vgl = -11 if (dabs(1.d0 - VGL(i,1) / (& dexp(-A(i) * r2) & )) > epsilon ) return - test_qmckl_ao_gaussians_vgl = -12 + test_qmckl_ao_gaussian_vgl = -12 if (dabs(1.d0 - VGL(i,2) / (& -2.d0 * A(i) * Y(1) * dexp(-A(i) * r2) & )) > epsilon ) return - test_qmckl_ao_gaussians_vgl = -13 + test_qmckl_ao_gaussian_vgl = -13 if (dabs(1.d0 - VGL(i,3) / (& -2.d0 * A(i) * Y(2) * dexp(-A(i) * r2) & )) > epsilon ) return - test_qmckl_ao_gaussians_vgl = -14 + test_qmckl_ao_gaussian_vgl = -14 if (dabs(1.d0 - VGL(i,4) / (& -2.d0 * A(i) * Y(3) * dexp(-A(i) * r2) & )) > epsilon ) return - test_qmckl_ao_gaussians_vgl = -15 + test_qmckl_ao_gaussian_vgl = -15 if (dabs(1.d0 - VGL(i,5) / (& A(i) * (4.d0*r2*A(i) - 6.d0) * dexp(-A(i) * r2) & )) > epsilon ) return end do - test_qmckl_ao_gaussians_vgl = 0 + test_qmckl_ao_gaussian_vgl = 0 deallocate(VGL) -end function test_qmckl_ao_gaussians_vgl +end function test_qmckl_ao_gaussian_vgl #+END_SRC #+BEGIN_SRC C :tangle test_qmckl_ao.c -int test_qmckl_ao_gaussians_vgl(qmckl_context context); -munit_assert_int(0, ==, test_qmckl_ao_gaussians_vgl(context)); - #+END_SRC +int test_qmckl_ao_gaussian_vgl(qmckl_context context); +munit_assert_int(0, ==, test_qmckl_ao_gaussian_vgl(context)); #+END_SRC diff --git a/src/qmckl_context.org b/src/qmckl_context.org index e407466..75a4bc8 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,7 +1,7 @@ ** Context - This file is written in C because it is more natural to express the context in - C than in Fortran. + This file is written in C because it is more natural to express the + context in C than in Fortran. 2 files are produced: - a source file : =qmckl_context.c= @@ -18,46 +18,82 @@ MunitResult test_qmckl_context() { #+END_SRC -*** Context +*** Context The context variable is a handle for the state of the library, and - is stored in the following data structure, which can't be seen - outside of the library. To simplify compatibility with other + is stored in the following data structure, which can't be seen + outside of the library. To simplify compatibility with other languages, the pointer to the internal data structure is converted into a 64-bit signed integer, defined in the =qmckl_context= type. A value of 0 for the context is equivalent to a =NULL= pointer. - #+BEGIN_SRC C :comments org :tangle qmckl.h + # The following code block should be kept to insert comments into + # the qmckl.h file + + #+BEGIN_SRC C :comments org :tangle qmckl.h :export none #+END_SRC -***** Source - - The tag is used internally to check if the memory domain pointed by - a pointer is a valid context. +**** Basis set data structure - #+BEGIN_SRC C :comments org :tangle qmckl_context.c + Data structure for the info related to the atomic orbitals + basis set. + + #+BEGIN_SRC C :comments org :tangle qmckl_context.c +typedef struct qmckl_ao_basis_struct { + + int64_t shell_num; + int64_t prim_num; + int64_t * shell_center; + int32_t * shell_ang_mom; + double * shell_factor; + double * exponent ; + double * coefficient ; + int64_t * shell_prim_num; + char type; + +} qmckl_ao_basis_struct; + #+END_SRC + +**** Source + + The tag is used internally to check if the memory domain pointed + by a pointer is a valid context. + + #+BEGIN_SRC C :comments org :tangle qmckl_context.c typedef struct qmckl_context_struct { + struct qmckl_context_struct * prev; + + /* Molecular system */ + // struct qmckl_nucleus_struct * nucleus; + // struct qmckl_electron_struct * electron; + struct qmckl_ao_basis_struct * ao_basis; + // struct qmckl_mo_struct * mo; + // struct qmckl_determinant_struct * det; + + /* Numerical precision */ uint32_t tag; int32_t precision; int32_t range; + } qmckl_context_struct; #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF - #+END_SRC + #+END_SRC -***** Test :noexport: - #+BEGIN_SRC C :tangle test_qmckl_context.c +**** Test :noexport: + #+BEGIN_SRC C :tangle test_qmckl_context.c qmckl_context context; qmckl_context new_context; - #+END_SRC + #+END_SRC **** =qmckl_context_check= - Checks if the domain pointed by the pointer is a valid context. - Returns the input =qmckl_context= if the context is valid, 0 otherwise. + Checks if the domain pointed by the pointer is a valid context. + Returns the input =qmckl_context= if the context is valid, 0 + otherwise. #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_check(const qmckl_context context) ; @@ -98,6 +134,7 @@ qmckl_context qmckl_context_create() { } context->prev = NULL; + context->ao_basis = NULL; context->precision = QMCKL_DEFAULT_PRECISION; context->range = QMCKL_DEFAULT_RANGE; context->tag = VALID_TAG; @@ -153,6 +190,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) { } new_context->prev = old_context; + new_context->ao_basis = old_context->ao_basis; new_context->precision = old_context->precision; new_context->range = old_context->range; new_context->tag = VALID_TAG; @@ -231,9 +269,9 @@ munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context - Fails if the 0-valued context is given in argument - Fails if the the pointer is not a valid context - #+BEGIN_SRC C :comments org :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_exit_code qmckl_context_destroy(qmckl_context context); - #+END_SRC + #+END_SRC ***** Source #+BEGIN_SRC C :tangle qmckl_context.c @@ -271,16 +309,296 @@ munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); #+END_SRC +*** Basis set + + For H_2 with the following basis set, + + #+BEGIN_EXAMPLE +HYDROGEN +S 5 +1 3.387000E+01 6.068000E-03 +2 5.095000E+00 4.530800E-02 +3 1.159000E+00 2.028220E-01 +4 3.258000E-01 5.039030E-01 +5 1.027000E-01 3.834210E-01 +S 1 +1 3.258000E-01 1.000000E+00 +S 1 +1 1.027000E-01 1.000000E+00 +P 1 +1 1.407000E+00 1.000000E+00 +P 1 +1 3.880000E-01 1.000000E+00 +D 1 +1 1.057000E+00 1.0000000 + #+END_EXAMPLE + + we have: + + #+BEGIN_EXAMPLE +type = 'G' +shell_num = 12 +prim_num = 20 +SHELL_CENTER = [1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2] +SHELL_ANG_MOM = ['S', 'S', 'S', 'P', 'P', 'D', 'S', 'S', 'S', 'P', 'P', 'D'] +SHELL_PRIM_NUM = [5, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1] +prim_index = [1, 6, 7, 8, 9, 10, 11, 16, 17, 18, 19, 20] +EXPONENT = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, + 1.407, 0.388, 1.057, 33.87, 5.095, 1.159, 0.3258, 0.1027, + 0.3258, 0.1027, 1.407, 0.388, 1.057] +COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421, + 1.0, 1.0, 1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822, + 0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0] + #+END_EXAMPLE + +**** =qmckl_context_update_ao_basis= + + Updates the data describing the AO basis set into the context. + + | =type= | Gaussian or Slater | + | =shell_num= | Number of shells | + | =prim_num= | Total number of primitives | + | =SHELL_CENTER(shell_num)= | Id of the nucleus on which the shell is centered | + | =SHELL_ANG_MOM(shell_num)= | Id of the nucleus on which the shell is centered | + | =SHELL_FACTOR(shell_num)= | Normalization factor for the shell | + | =SHELL_PRIM_NUM(shell_num)= | Number of primitives in the shell | + | =SHELL_PRIM_INDEX(shell_num)= | Address of the first primitive of the shelll in the =EXPONENT= array | + | =EXPONENT(prim_num)= | Array of exponents | + | =COEFFICIENT(prim_num)= | Array of coefficients | + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_exit_code +qmckl_context_update_ao_basis(qmckl_context context , const char type, + const int64_t shell_num , const int64_t prim_num, + const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, + const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, + const int64_t * SHELL_PRIM_INDEX, + const double * EXPONENT , const double * COEFFICIENT); + #+END_SRC + +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c +qmckl_exit_code +qmckl_context_update_ao_basis(qmckl_context context , const char type, + const int64_t shell_num , const int64_t prim_num, + const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, + const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, + const int64_t * SHELL_PRIM_INDEX, + const double * EXPONENT , const double * COEFFICIENT) +{ + + int64_t i; + + /* Check input */ + + if (type != 'G' && type != 'S') return QMCKL_FAILURE; + if (shell_num <= 0) return QMCKL_FAILURE; + if (prim_num <= 0) return QMCKL_FAILURE; + if (prim_num < shell_num) return QMCKL_FAILURE; + + for (i=0 ; ishell_center = (int64_t*) malloc (shell_num * sizeof(int64_t)); + if (basis->shell_center == NULL) { + free(basis); + return QMCKL_FAILURE; + } + + basis->shell_ang_mom = (int32_t*) malloc (shell_num * sizeof(int32_t)); + if (basis->shell_ang_mom == NULL) { + free(basis->shell_center); + free(basis); + return QMCKL_FAILURE; + } + + basis->shell_prim_num= (int64_t*) malloc (shell_num * sizeof(int64_t)); + if (basis->shell_prim_num == NULL) { + free(basis->shell_ang_mom); + free(basis->shell_center); + free(basis); + return QMCKL_FAILURE; + } + + basis->shell_factor = (double *) malloc (shell_num * sizeof(double )); + if (basis->shell_factor == NULL) { + free(basis->shell_prim_num); + free(basis->shell_ang_mom); + free(basis->shell_center); + free(basis); + return QMCKL_FAILURE; + } + + basis->exponent = (double *) malloc (prim_num * sizeof(double )); + if (basis->exponent == NULL) { + free(basis->shell_factor); + free(basis->shell_prim_num); + free(basis->shell_ang_mom); + free(basis->shell_center); + free(basis); + return QMCKL_FAILURE; + } + + basis->coefficient = (double *) malloc (prim_num * sizeof(double )); + if (basis->coefficient == NULL) { + free(basis->exponent); + free(basis->shell_factor); + free(basis->shell_prim_num); + free(basis->shell_ang_mom); + free(basis->shell_center); + free(basis); + return QMCKL_FAILURE; + } + + + /* Assign data */ + + basis->type = type; + basis->shell_num = shell_num; + basis->prim_num = prim_num; + + for (i=0 ; ishell_center [i] = SHELL_CENTER [i]; + basis->shell_ang_mom [i] = SHELL_ANG_MOM [i]; + basis->shell_prim_num[i] = SHELL_PRIM_NUM[i]; + basis->shell_factor [i] = SHELL_FACTOR [i]; + } + + for (i=0 ; iexponent [i] = EXPONENT[i]; + basis->coefficient[i] = COEFFICIENT[i]; + } + + ctx->ao_basis = basis; + return QMCKL_SUCCESS; +} + #+END_SRC + +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 + interface + integer (c_int32_t) function qmckl_context_update_ao_basis(context, & + typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & + SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, COEFFICIENT) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + character(c_char) , intent(in), value :: typ + integer (c_int64_t), intent(in), value :: shell_num + integer (c_int64_t), intent(in), value :: prim_num + integer (c_int64_t), intent(in) :: SHELL_CENTER(shell_num) + integer (c_int32_t), intent(in) :: SHELL_ANG_MOM(shell_num) + double precision , intent(in) :: SHELL_FACTOR(shell_num) + integer (c_int64_t), intent(in) :: SHELL_PRIM_NUM(shell_num) + integer (c_int64_t), intent(in) :: SHELL_PRIM_INDEX(shell_num) + double precision , intent(in) :: EXPONENT(prim_num) + double precision , intent(in) :: COEFFICIENT(prim_num) + end function qmckl_context_update_ao_basis + end interface + #+END_SRC + +***** TODO Test + +**** =qmckl_context_set_ao_basis= + + Sets the data describing the AO basis set into the context. + + | =type= | Gaussian or Slater | + | =shell_num= | Number of shells | + | =prim_num= | Total number of primitives | + | =SHELL_CENTER(shell_num)= | Id of the nucleus on which the shell is centered | + | =SHELL_ANG_MOM(shell_num)= | Id of the nucleus on which the shell is centered | + | =SHELL_FACTOR(shell_num)= | Normalization factor for the shell | + | =SHELL_PRIM_NUM(shell_num)= | Number of primitives in the shell | + | =SHELL_PRIM_INDEX(shell_num)= | Address of the first primitive of the shelll in the =EXPONENT= array | + | =EXPONENT(prim_num)= | Array of exponents | + | =COEFFICIENT(prim_num)= | Array of coefficients | + + #+BEGIN_SRC C :comments org :tangle qmckl.h +qmckl_context +qmckl_context_set_ao_basis(const qmckl_context context , const char type, + const int64_t shell_num , const int64_t prim_num, + const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, + const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, + const int64_t * SHELL_PRIM_INDEX, + const double * EXPONENT , const double * COEFFICIENT); + #+END_SRC + +***** Source + #+BEGIN_SRC C :tangle qmckl_context.c +qmckl_context +qmckl_context_set_ao_basis(const qmckl_context context , const char type, + const int64_t shell_num , const int64_t prim_num, + const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, + const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, + const int64_t * SHELL_PRIM_INDEX, + const double * EXPONENT , const double * COEFFICIENT) +{ + + qmckl_context new_context = qmckl_context_copy(context); + if (new_context == 0) return 0; + + if (qmckl_context_update_ao_basis(context, type, shell_num, prim_num, + SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, + SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, + COEFFICIENT + ) == QMCKL_FAILURE) + return 0; + + return new_context; +} + #+END_SRC + +***** Fortran interface + #+BEGIN_SRC f90 :tangle qmckl_f.f90 + interface + integer (c_int64_t) function qmckl_context_set_ao_basis(context, & + typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & + SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, COEFFICIENT) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + character(c_char) , intent(in), value :: typ + integer (c_int64_t), intent(in), value :: shell_num + integer (c_int64_t), intent(in), value :: prim_num + integer (c_int64_t), intent(in) :: SHELL_CENTER(shell_num) + integer (c_int32_t), intent(in) :: SHELL_ANG_MOM(shell_num) + double precision , intent(in) :: SHELL_FACTOR(shell_num) + integer (c_int64_t), intent(in) :: SHELL_PRIM_NUM(shell_num) + integer (c_int64_t), intent(in) :: SHELL_PRIM_INDEX(shell_num) + double precision , intent(in) :: EXPONENT(prim_num) + double precision , intent(in) :: COEFFICIENT(prim_num) + end function qmckl_context_set_ao_basis + end interface + #+END_SRC + +***** TODO Test *** Precision - The following functions set and get the expected required precision - and range. =precision= should be an integer between 2 and 53, and - =range= should be an integer between 2 and 11. + The following functions set and get the expected required + precision and range. =precision= should be an integer between 2 + and 53, and =range= should be an integer between 2 and 11. - The setter functions functions return a new context as a 64-bit integer. - The getter functions return the value, as a 32-bit integer. - The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. + The setter functions functions return a new context as a 64-bit + integer. The getter functions return the value, as a 32-bit + integer. The update functions return =QMCKL_SUCCESS= or + =QMCKL_FAILURE=. **** =qmckl_context_update_precision= Modifies the parameter for the numerical precision in a given context. @@ -350,7 +668,7 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in ***** TODO Tests :noexport: **** =qmckl_context_set_precision= Returns a copy of the context with a different precision parameter. - #+BEGIN_SRC C :comments or :tangle qmckl.h + #+BEGIN_SRC C :comments org :tangle qmckl.h qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC @@ -369,7 +687,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int ***** Fortran interface #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface - integer (c_int32_t) function qmckl_context_set_precision(context, precision) bind(C) + integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context integer (c_int32_t), intent(in), value :: precision @@ -399,7 +717,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran ***** Fortran interface #+BEGIN_SRC f90 :tangle qmckl_f.f90 interface - integer (c_int32_t) function qmckl_context_set_range(context, range) bind(C) + integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context integer (c_int32_t), intent(in), value :: range @@ -486,11 +804,7 @@ double qmckl_context_get_epsilon(const qmckl_context context) { ***** TODO Tests :noexport: -*** Info about the molecular system - -**** TODO =qmckl_context_set_nucl_coord= -**** TODO =qmckl_context_set_nucl_charge= -**** TODO =qmckl_context_set_elec_num= + *** End of files :noexport: From efb1c52a613259eadbf5e165a2a4ed1421f386d8 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 25 Nov 2020 18:41:55 +0100 Subject: [PATCH 61/61] Update workflows with master branch --- .github/workflows/gh-pages.yml | 2 +- .github/workflows/test-build.yml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/gh-pages.yml b/.github/workflows/gh-pages.yml index 45b9ebe..7cbcafa 100644 --- a/.github/workflows/gh-pages.yml +++ b/.github/workflows/gh-pages.yml @@ -3,7 +3,7 @@ name: github pages on: push: branches: - - main + - master jobs: deploy: diff --git a/.github/workflows/test-build.yml b/.github/workflows/test-build.yml index de8c820..bcc00a2 100644 --- a/.github/workflows/test-build.yml +++ b/.github/workflows/test-build.yml @@ -2,9 +2,9 @@ name: test-build on: push: - branches: [ main ] + branches: [ master ] pull_request: - branches: [ main ] + branches: [ master ] jobs: build: