mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-08-18 11:21:44 +02:00
commit
afed24ff40
23
.github/workflows/gh-pages.yml
vendored
23
.github/workflows/gh-pages.yml
vendored
@ -24,11 +24,26 @@ jobs:
|
||||
run: git clone https://github.com/hniksic/emacs-htmlize && cp emacs-htmlize/htmlize.el docs/
|
||||
|
||||
- name: make
|
||||
run: make -C src/ doc
|
||||
run: make -C src/ doc && ls -sh ./docs/
|
||||
|
||||
- name: pwd
|
||||
run: pwd
|
||||
|
||||
- name: ls
|
||||
run: ls -sh ./docs
|
||||
|
||||
# - name: Deploy
|
||||
# uses: peaceiris/actions-gh-pages@v3
|
||||
# with:
|
||||
# github_token: ${{ secrets.GITHUB_TOKEN }}
|
||||
# publish_dir: ./docs
|
||||
|
||||
- name: Deploy
|
||||
uses: peaceiris/actions-gh-pages@v3
|
||||
uses: JamesIves/github-pages-deploy-action@4.1.0
|
||||
with:
|
||||
github_token: ${{ secrets.GITHUB_TOKEN }}
|
||||
publish_dir: ./docs
|
||||
branch: gh-pages
|
||||
folder: ./docs
|
||||
|
||||
# github_token: ${{ secrets.GITHUB_TOKEN }}
|
||||
# publish_dir: ./docs
|
||||
|
||||
|
4
.github/workflows/test-build.yml
vendored
4
.github/workflows/test-build.yml
vendored
@ -37,4 +37,6 @@ jobs:
|
||||
git submodule sync
|
||||
git submodule update --init --recursive
|
||||
- name: make
|
||||
run: make -C src/ test
|
||||
run: make -C src/ check
|
||||
- name: make
|
||||
run: make distcheck
|
||||
|
12
.gitignore
vendored
Normal file
12
.gitignore
vendored
Normal file
@ -0,0 +1,12 @@
|
||||
docs/index.html
|
||||
docs/htmlize.el
|
||||
autom4te.cache/
|
||||
config.log
|
||||
config.status
|
||||
src/auto/
|
||||
src/ltximg/
|
||||
src/qmckl.mod
|
||||
*.swp
|
||||
*.tar.gz
|
||||
|
||||
|
3
.gitmodules
vendored
3
.gitmodules
vendored
@ -1,3 +1,6 @@
|
||||
[submodule "munit"]
|
||||
path = munit
|
||||
url = https://github.com/nemequ/munit/
|
||||
[submodule "docs/org-html-themes"]
|
||||
path = docs/org-html-themes
|
||||
url = https://github.com/fniessen/org-html-themes.git
|
||||
|
78
Makefile
Normal file
78
Makefile
Normal file
@ -0,0 +1,78 @@
|
||||
# Use POSIX-compliant Makefiles
|
||||
.POSIX:
|
||||
|
||||
# Clear suffix list
|
||||
.SUFFIXES:
|
||||
|
||||
package = qmckl
|
||||
version = 0.1-alpha
|
||||
tarname = $(package)
|
||||
distdir = $(tarname)-$(version)
|
||||
prefix = /usr/local
|
||||
|
||||
QMCKL_ROOT=$(CURDIR)
|
||||
shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so
|
||||
static_lib=$(QMCKL_ROOT)/lib/libqmckl.a
|
||||
qmckl_h=$(QMCKL_ROOT)/include/qmckl.h
|
||||
qmckl_f=$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90
|
||||
|
||||
export prefix shared_lib static_lib qmckl_h qmckl_f
|
||||
|
||||
|
||||
all clean doc check install uninstall:
|
||||
$(MAKE) -C src $@
|
||||
|
||||
dist: $(distdir).tar.gz
|
||||
|
||||
|
||||
$(distdir).tar.gz: $(distdir)
|
||||
tar chof - $(distdir) | gzip -9 -c > $@
|
||||
rm -rf $(distdir)
|
||||
|
||||
|
||||
$(distdir): $(qmckl_h) $(qmckl_f) $(static_lib) $(shared_lib) src/Makefile.generated doc FORCE
|
||||
mkdir -p $(distdir)
|
||||
mkdir -p $(distdir)/munit
|
||||
mkdir -p $(distdir)/src
|
||||
mkdir -p $(distdir)/include
|
||||
mkdir -p $(distdir)/share/qmckl/fortran
|
||||
mkdir -p $(distdir)/share/doc/qmckl/html/
|
||||
mkdir -p $(distdir)/share/doc/qmckl/text/
|
||||
mkdir -p $(distdir)/man
|
||||
cp munit/munit.h munit/munit.c $(distdir)/munit/
|
||||
cp src/*.c src/*.h src/*.f90 $(distdir)/src/
|
||||
cp src/Makefile.generated $(distdir)/src/Makefile
|
||||
cp include/* $(distdir)/include
|
||||
cp Makefile $(distdir)/
|
||||
cp docs/*.html $(distdir)/share/doc/qmckl/html/
|
||||
cp docs/*.css $(distdir)/share/doc/qmckl/html/
|
||||
cp docs/*.txt $(distdir)/share/doc/qmckl/text/
|
||||
cp share/qmckl/fortran/* $(distdir)/share/qmckl/fortran
|
||||
mkdir -p $(distdir)/lib
|
||||
|
||||
|
||||
FORCE:
|
||||
rm -f -- $(distdir).tar.gz
|
||||
rm -rf -- $(distdir)
|
||||
|
||||
|
||||
distcheck: $(distdir).tar.gz
|
||||
gzip -cd $(distdir).tar.gz | tar xvf -
|
||||
cd $(distdir) && $(MAKE) all check
|
||||
rm $(distdir)/lib/libqmckl.so
|
||||
rm $(distdir)/include/qmckl.h
|
||||
rm $(distdir)/share/qmckl/fortran/qmckl_f.f90
|
||||
rm $(distdir)/share/doc/qmckl/html/*.html
|
||||
rm $(distdir)/share/doc/qmckl/html/*.css
|
||||
rm $(distdir)/share/doc/qmckl/text/*.txt
|
||||
cd $(distdir) && $(MAKE) clean
|
||||
rm -rf $(distdir)
|
||||
@echo "*** Package $(distdir).tar.gz is ready for distribution."
|
||||
|
||||
|
||||
$(qmckl_h) $(qmckl_f) $(static_lib) $(shared_lib) src/Makefile.generated:
|
||||
$(MAKE) -C src $@
|
||||
|
||||
|
||||
|
||||
.PHONY: all clean dist doc install uninstall FORCE
|
3
TODO.org
3
TODO.org
@ -16,3 +16,6 @@ context.
|
||||
* Complex numbers
|
||||
* Adjustable number for derivatives (1,2,3)
|
||||
|
||||
* Put pictures
|
||||
* Make the Makefile part of the documented code ?
|
||||
* Put the data-flow graph in the code.
|
||||
|
137
configure.org
Normal file
137
configure.org
Normal file
@ -0,0 +1,137 @@
|
||||
#+TITLE: QMCkl configuration
|
||||
|
||||
This files contains al the information to generate the files required
|
||||
by Autotools to build the =configure= script for the library.
|
||||
|
||||
* Scripts analyzing source code
|
||||
|
||||
** Version of the library
|
||||
|
||||
#+NAME: version
|
||||
#+BEGIN_SRC sh
|
||||
echo 1.0
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: version
|
||||
: 1.0
|
||||
|
||||
#+NAME: issues
|
||||
#+BEGIN_SRC sh
|
||||
echo "https://github.com/TREX-CoE/qmckl/issues"
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: issues
|
||||
: https://github.com/TREX-CoE/qmckl/issues
|
||||
|
||||
#+NAME: website
|
||||
#+BEGIN_SRC sh
|
||||
echo "https://trex-coe.github.io/qmckl/index.html"
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: website
|
||||
: https://trex-coe.github.io/qmckl/index.html
|
||||
|
||||
|
||||
#+NAME: revision
|
||||
#+BEGIN_SRC sh
|
||||
git log --oneline | head -1
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: revision
|
||||
: 5f2da3e Fixed website
|
||||
|
||||
** C Header files
|
||||
|
||||
#+NAME: headers
|
||||
#+BEGIN_SRC sh :tangle no
|
||||
#grep --regexp="\#include\\s+<.*>" --no-filename src/*.org \
|
||||
grep --regexp="\#include\\s*<.*>" --no-filename src/*.org \
|
||||
| sort \
|
||||
| uniq \
|
||||
| cut -d '<' -f 2 \
|
||||
| cut -d '>' -f 1 \
|
||||
| tr '\n' ' '
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: headers
|
||||
: assert.h errno.h math.h stdint.h stdlib.h string.h
|
||||
|
||||
|
||||
* configure.ac
|
||||
|
||||
** Initialization
|
||||
|
||||
#+BEGIN_SRC sh :noweb yes :tangle configure.ac
|
||||
# This file was generated from the org-mode file configure.org
|
||||
|
||||
VERSION=[<<version()>>]
|
||||
AC_SUBST([VERSION])
|
||||
|
||||
AC_REVISION([<<revision()>>])
|
||||
AC_INIT([QMCkl],[<<version()>>],
|
||||
[<<issues()>>], [],
|
||||
[<<website()>>])
|
||||
#+END_SRC
|
||||
|
||||
** Source files
|
||||
#+BEGIN_SRC sh :noweb yes :tangle configure.ac
|
||||
AC_CONFIG_SRCDIR([src/README.org])
|
||||
#+END_SRC
|
||||
|
||||
** C Compiler
|
||||
|
||||
#+BEGIN_SRC sh :noweb yes :tangle configure.ac
|
||||
AC_LANG_PUSH([C])
|
||||
AC_PROG_CC
|
||||
|
||||
AC_CHECK_HEADERS([<<headers()>>])
|
||||
#+END_SRC
|
||||
|
||||
** Fortran Compiler
|
||||
|
||||
#+BEGIN_SRC sh :noweb yes :tangle configure.ac
|
||||
AC_PROG_FC([ifort gfortran flang],[Fortran])
|
||||
AC_PROG_FC_C_O
|
||||
AC_FC_SRCEXT([f90])
|
||||
AC_FC_FREEFORM
|
||||
#+END_SRC
|
||||
|
||||
** External libraries
|
||||
|
||||
#+BEGIN_SRC sh :tangle configure.ac
|
||||
AC_CHECK_HEADER([munit/munit.h], [echo found], [echo not found] )
|
||||
|
||||
AC_CHECK_LIB([pthread], [pthread_create])
|
||||
|
||||
AC_SEARCH_LIBS([dgemm], [blas mkl],
|
||||
[],
|
||||
AC_MSG_ERROR([Unable to find a BLAS library])
|
||||
])
|
||||
#+END_SRC
|
||||
|
||||
** Makefile
|
||||
|
||||
#+BEGIN_SRC sh :tangle configure.ac
|
||||
AC_CONFIG_FILES(Makefile)
|
||||
#+END_SRC
|
||||
|
||||
** Library
|
||||
|
||||
#+BEGIN_SRC sh :tangle configure.ac
|
||||
|
||||
#+END_SRC
|
||||
|
||||
** Documentation
|
||||
|
||||
#+BEGIN_SRC sh :noweb yes :tangle configure.ac
|
||||
AC_CHECK_PROGS([HAS_EMACS],[emacs],[])
|
||||
#+END_SRC
|
||||
|
||||
** Finalization
|
||||
|
||||
#+BEGIN_SRC sh :tangle configure.ac
|
||||
AC_OUTPUT
|
||||
#+END_SRC
|
||||
|
||||
* Makefile.am
|
||||
|
1
docs/.gitignore
vendored
1
docs/.gitignore
vendored
@ -0,0 +1 @@
|
||||
*.txt
|
1
docs/org-html-themes
Submodule
1
docs/org-html-themes
Submodule
@ -0,0 +1 @@
|
||||
Subproject commit f7224a489462abc2c2174edbf7d4e82c0e276183
|
972
docs/qmckl.css
Normal file
972
docs/qmckl.css
Normal file
@ -0,0 +1,972 @@
|
||||
/* Adapted from worg.css */
|
||||
|
||||
@import url(https://fonts.googleapis.com/css?family=Droid+Sans|Droid+Sans+Mono|Droid+Serif);
|
||||
|
||||
@media all
|
||||
{
|
||||
html {
|
||||
margin: 0;
|
||||
font: .9em/1.6em "Droid Serif", Cambria, Georgia, "DejaVu Serif", serif;
|
||||
background-image: url(/img/org-mode-unicorn-logo-worg.png);
|
||||
background-attachment: fixed;
|
||||
background-position: right bottom;
|
||||
background-repeat: no-repeat;
|
||||
background-color: white;
|
||||
}
|
||||
|
||||
body {
|
||||
font-size: 14pt;
|
||||
line-height: 22pt;
|
||||
color: black;
|
||||
margin-top: 0;
|
||||
}
|
||||
|
||||
body #content {
|
||||
padding-top: 2em;
|
||||
margin: auto;
|
||||
max-width: 70%;
|
||||
background-color: white;
|
||||
}
|
||||
|
||||
body #support {
|
||||
position: fixed;
|
||||
top:0;
|
||||
display:block;
|
||||
font-size: 12pt;
|
||||
right:0pt;
|
||||
text-align: right;
|
||||
padding: .2em 1em;
|
||||
background: #EEE;
|
||||
border-radius: 10px;
|
||||
}
|
||||
|
||||
body .title {
|
||||
margin-left: 0px;
|
||||
font-size: 22pt;
|
||||
}
|
||||
|
||||
#org-div-home-and-up{
|
||||
position: fixed;
|
||||
right: 0.5em;
|
||||
margin-top: 70px;
|
||||
font-family:sans-serif;
|
||||
}
|
||||
|
||||
/* TOC inspired by http://jashkenas.github.com/coffee-script */
|
||||
#table-of-contents {
|
||||
margin-top: 105px;
|
||||
font-size: 10pt;
|
||||
font-family:sans-serif;
|
||||
position: fixed;
|
||||
right: 0em;
|
||||
top: 0em;
|
||||
background: white;
|
||||
line-height: 12pt;
|
||||
text-align: right;
|
||||
box-shadow: 0 0 1em #777777;
|
||||
-webkit-box-shadow: 0 0 1em #777777;
|
||||
-moz-box-shadow: 0 0 1em #777777;
|
||||
-webkit-border-bottom-left-radius: 5px;
|
||||
-moz-border-radius-bottomleft: 5px;
|
||||
/* ensure doesn't flow off the screen when expanded */
|
||||
max-height: 80%;
|
||||
overflow: auto; }
|
||||
#table-of-contents h2 {
|
||||
font-size: 13pt;
|
||||
max-width: 9em;
|
||||
border: 0;
|
||||
font-weight: normal;
|
||||
padding-left: 0.5em;
|
||||
padding-right: 0.5em;
|
||||
padding-top: 0.05em;
|
||||
padding-bottom: 0.05em; }
|
||||
#table-of-contents #text-table-of-contents {
|
||||
display: none;
|
||||
text-align: left; }
|
||||
#table-of-contents:hover #text-table-of-contents {
|
||||
display: block;
|
||||
padding: 0.5em;
|
||||
margin-top: -1.5em; }
|
||||
|
||||
#license {
|
||||
background-color: #eeeeee;
|
||||
}
|
||||
|
||||
h1 {
|
||||
font-size:2.1em;
|
||||
padding:0 0 30px 0;
|
||||
margin-top: 10px;
|
||||
margin-bottom: 10px;
|
||||
margin-right: 7%;
|
||||
color: grey;
|
||||
}
|
||||
|
||||
h2 {
|
||||
font-family:sans-serif;
|
||||
font-size:1.45em;
|
||||
padding:10px 0 10px 0;
|
||||
color: black;
|
||||
border-bottom: 1px solid #ddd;
|
||||
padding-top: 1.5em;
|
||||
}
|
||||
|
||||
.outline-text-2 {
|
||||
margin-left: 0.1em
|
||||
}
|
||||
|
||||
h3 {
|
||||
font-family:sans-serif;
|
||||
font-size:1.3em;
|
||||
color: grey;
|
||||
margin-left: 0.6em;
|
||||
padding-top: 1.5em;
|
||||
}
|
||||
|
||||
/* #A34D32;*/
|
||||
|
||||
|
||||
.outline-text-3 {
|
||||
margin-left: 0.9em;
|
||||
}
|
||||
|
||||
h4 {
|
||||
font-family:sans-serif;
|
||||
font-size:1.2em;
|
||||
margin-left: 1.2em;
|
||||
color: #A5573E;
|
||||
padding-top: 1.5em;
|
||||
}
|
||||
|
||||
.outline-text-4 {
|
||||
margin-left: 1.45em;
|
||||
}
|
||||
|
||||
a {text-decoration: none; font-weight: 400;}
|
||||
a:visited {text-decoration: none; font-weight: 400;}
|
||||
a:hover {text-decoration: underline;}
|
||||
|
||||
.todo {
|
||||
color: #CA0000;
|
||||
}
|
||||
|
||||
.done {
|
||||
color: #006666;
|
||||
}
|
||||
|
||||
.timestamp-kwd {
|
||||
color: #444;
|
||||
}
|
||||
|
||||
.tag {
|
||||
background-color: #ffff;
|
||||
color: #ffff;
|
||||
}
|
||||
|
||||
li {
|
||||
margin: .4em;
|
||||
}
|
||||
|
||||
table {
|
||||
border: 1;
|
||||
border-color: grey;
|
||||
}
|
||||
|
||||
thead {
|
||||
border: 0;
|
||||
}
|
||||
|
||||
tbody {
|
||||
border: 0;
|
||||
}
|
||||
|
||||
tr {
|
||||
border: 0;
|
||||
}
|
||||
|
||||
td {
|
||||
border-left: 0px;
|
||||
border-right: 0px;
|
||||
border-top: 0px;
|
||||
border-bottom: 0px;
|
||||
}
|
||||
|
||||
th {
|
||||
border-left: 0px;
|
||||
border-right: 0px;
|
||||
border-top: 1px solid grey;
|
||||
border-bottom: 1px solid grey;
|
||||
}
|
||||
|
||||
code {
|
||||
font-size: 100%;
|
||||
color: black;
|
||||
padding: 0px 0.2em;
|
||||
}
|
||||
|
||||
img {
|
||||
border: 0;
|
||||
}
|
||||
|
||||
.share img {
|
||||
opacity: .4;
|
||||
-moz-opacity: .4;
|
||||
filter: alpha(opacity=40);
|
||||
}
|
||||
|
||||
.share img:hover {
|
||||
opacity: 1;
|
||||
-moz-opacity: 1;
|
||||
filter: alpha(opacity=100);
|
||||
}
|
||||
|
||||
pre {
|
||||
font-family: Droid Sans Mono, Monaco, Consolas, "Lucida Console", monospace;
|
||||
color: black;
|
||||
font-size: 90%;
|
||||
padding: 0.5em;
|
||||
overflow: auto;
|
||||
border: none;
|
||||
background-color: #f2f2f2;
|
||||
border-radius: 5px;
|
||||
}
|
||||
|
||||
.org-info-box {
|
||||
clear:both;
|
||||
margin-left:auto;
|
||||
margin-right:auto;
|
||||
padding:0.7em;
|
||||
}
|
||||
.org-info-box img {
|
||||
float:left;
|
||||
margin:0em 0.5em 0em 0em;
|
||||
}
|
||||
.org-info-box p {
|
||||
margin:0em;
|
||||
padding:0em;
|
||||
}
|
||||
|
||||
|
||||
.builtin {
|
||||
/* font-lock-builtin-face */
|
||||
color: #f4a460;
|
||||
}
|
||||
.comment {
|
||||
/* font-lock-comment-face */
|
||||
color: #737373;
|
||||
}
|
||||
.comment-delimiter {
|
||||
/* font-lock-comment-delimiter-face */
|
||||
color: #666666;
|
||||
}
|
||||
.constant {
|
||||
/* font-lock-constant-face */
|
||||
color: #db7093;
|
||||
}
|
||||
.doc {
|
||||
/* font-lock-doc-face */
|
||||
color: #b3b3b3;
|
||||
}
|
||||
.function-name {
|
||||
/* font-lock-function-name-face */
|
||||
color: #5f9ea0;
|
||||
}
|
||||
.headline {
|
||||
/* headline-face */
|
||||
color: #ffffff;
|
||||
background-color: #000000;
|
||||
font-weight: bold;
|
||||
}
|
||||
.keyword {
|
||||
/* font-lock-keyword-face */
|
||||
color: #4682b4;
|
||||
}
|
||||
.negation-char {
|
||||
}
|
||||
.regexp-grouping-backslash {
|
||||
}
|
||||
.regexp-grouping-construct {
|
||||
}
|
||||
.string {
|
||||
/* font-lock-string-face */
|
||||
color: #ccc79a;
|
||||
}
|
||||
.todo-comment {
|
||||
/* todo-comment-face */
|
||||
color: #ffffff;
|
||||
background-color: #000000;
|
||||
font-weight: bold;
|
||||
}
|
||||
.variable-name {
|
||||
/* font-lock-variable-name-face */
|
||||
color: #ff6a6a;
|
||||
}
|
||||
.warning {
|
||||
/* font-lock-warning-face */
|
||||
color: #ffffff;
|
||||
background-color: #cd5c5c;
|
||||
font-weight: bold;
|
||||
}
|
||||
.important {
|
||||
/* font-lock-warning-face */
|
||||
background-color: #e3e3f7;
|
||||
}
|
||||
.exercise {
|
||||
/* font-lock-warning-face */
|
||||
background-color: #e3f7e3;
|
||||
}
|
||||
.note {
|
||||
/* font-lock-warning-face */
|
||||
background-color: #f7f7d9;
|
||||
}
|
||||
pre.a {
|
||||
color: inherit;
|
||||
background-color: inherit;
|
||||
font: inherit;
|
||||
text-decoration: inherit;
|
||||
}
|
||||
pre.a:hover {
|
||||
text-decoration: underline;
|
||||
}
|
||||
|
||||
/* Styles for org-info.js */
|
||||
|
||||
.org-info-js_info-navigation
|
||||
{
|
||||
border-style:none;
|
||||
}
|
||||
|
||||
#org-info-js_console-label
|
||||
{
|
||||
font-size:10px;
|
||||
font-weight:bold;
|
||||
white-space:nowrap;
|
||||
}
|
||||
|
||||
.org-info-js_search-highlight
|
||||
{
|
||||
background-color:#ffff00;
|
||||
color:#000000;
|
||||
font-weight:bold;
|
||||
}
|
||||
|
||||
#org-info-js-window
|
||||
{
|
||||
border-bottom:1px solid black;
|
||||
padding-bottom:10px;
|
||||
margin-bottom:10px;
|
||||
}
|
||||
|
||||
|
||||
|
||||
.org-info-search-highlight
|
||||
{
|
||||
background-color:#adefef; /* same color as emacs default */
|
||||
color:#000000;
|
||||
font-weight:bold;
|
||||
}
|
||||
|
||||
.org-bbdb-company {
|
||||
/* bbdb-company */
|
||||
font-style: italic;
|
||||
}
|
||||
.org-bbdb-field-name {
|
||||
}
|
||||
.org-bbdb-field-value {
|
||||
}
|
||||
.org-bbdb-name {
|
||||
/* bbdb-name */
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-bold {
|
||||
/* bold */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-bold-italic {
|
||||
/* bold-italic */
|
||||
font-weight: bold;
|
||||
font-style: italic;
|
||||
}
|
||||
.org-border {
|
||||
/* border */
|
||||
background-color: #000000;
|
||||
}
|
||||
.org-buffer-menu-buffer {
|
||||
/* buffer-menu-buffer */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-builtin {
|
||||
/* font-lock-builtin-face */
|
||||
color: #da70d6;
|
||||
}
|
||||
.org-button {
|
||||
/* button */
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-c-nonbreakable-space {
|
||||
/* c-nonbreakable-space-face */
|
||||
background-color: #ff0000;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-calendar-today {
|
||||
/* calendar-today */
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-comment {
|
||||
/* font-lock-comment-face */
|
||||
color: #b22222;
|
||||
}
|
||||
.org-comment-delimiter {
|
||||
/* font-lock-comment-delimiter-face */
|
||||
color: #b22222;
|
||||
}
|
||||
.org-constant {
|
||||
/* font-lock-constant-face */
|
||||
color: #5f9ea0;
|
||||
}
|
||||
.org-cursor {
|
||||
/* cursor */
|
||||
background-color: #000000;
|
||||
}
|
||||
.org-default {
|
||||
/* default */
|
||||
color: #000000;
|
||||
background-color: #ffffff;
|
||||
}
|
||||
.org-diary {
|
||||
/* diary */
|
||||
color: #ff0000;
|
||||
}
|
||||
.org-doc {
|
||||
/* font-lock-doc-face */
|
||||
color: #bc8f8f;
|
||||
}
|
||||
.org-escape-glyph {
|
||||
/* escape-glyph */
|
||||
color: #a52a2a;
|
||||
}
|
||||
.org-file-name-shadow {
|
||||
/* file-name-shadow */
|
||||
color: #7f7f7f;
|
||||
}
|
||||
.org-fixed-pitch {
|
||||
}
|
||||
.org-fringe {
|
||||
/* fringe */
|
||||
background-color: #f2f2f2;
|
||||
}
|
||||
.org-function-name {
|
||||
/* font-lock-function-name-face */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-header-line {
|
||||
/* header-line */
|
||||
color: #333333;
|
||||
background-color: #e5e5e5;
|
||||
}
|
||||
.org-help-argument-name {
|
||||
/* help-argument-name */
|
||||
font-style: italic;
|
||||
}
|
||||
.org-highlight {
|
||||
/* highlight */
|
||||
background-color: #b4eeb4;
|
||||
}
|
||||
.org-holiday {
|
||||
/* holiday */
|
||||
background-color: #ffc0cb;
|
||||
}
|
||||
.org-info-header-node {
|
||||
/* info-header-node */
|
||||
color: #a52a2a;
|
||||
font-weight: bold;
|
||||
font-style: italic;
|
||||
}
|
||||
.org-info-header-xref {
|
||||
/* info-header-xref */
|
||||
color: #0000ff;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-info-menu-header {
|
||||
/* info-menu-header */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-info-menu-star {
|
||||
/* info-menu-star */
|
||||
color: #ff0000;
|
||||
}
|
||||
.org-info-node {
|
||||
/* info-node */
|
||||
color: #a52a2a;
|
||||
font-weight: bold;
|
||||
font-style: italic;
|
||||
}
|
||||
.org-info-title-1 {
|
||||
/* info-title-1 */
|
||||
font-size: 172%;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-info-title-2 {
|
||||
/* info-title-2 */
|
||||
font-size: 144%;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-info-title-3 {
|
||||
/* info-title-3 */
|
||||
font-size: 120%;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-info-title-4 {
|
||||
/* info-title-4 */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-info-xref {
|
||||
/* info-xref */
|
||||
color: #0000ff;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-isearch {
|
||||
/* isearch */
|
||||
color: #b0e2ff;
|
||||
background-color: #cd00cd;
|
||||
}
|
||||
.org-italic {
|
||||
/* italic */
|
||||
font-style: italic;
|
||||
}
|
||||
.org-keyword {
|
||||
/* font-lock-keyword-face */
|
||||
color: #a020f0;
|
||||
}
|
||||
.org-lazy-highlight {
|
||||
/* lazy-highlight */
|
||||
background-color: #afeeee;
|
||||
}
|
||||
.org-link {
|
||||
/* link */
|
||||
color: #0000ff;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-link-visited {
|
||||
/* link-visited */
|
||||
color: #8b008b;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-match {
|
||||
/* match */
|
||||
background-color: #ffff00;
|
||||
}
|
||||
.org-menu {
|
||||
}
|
||||
.org-message-cited-text {
|
||||
/* message-cited-text */
|
||||
color: #ff0000;
|
||||
}
|
||||
.org-message-header-cc {
|
||||
/* message-header-cc */
|
||||
color: #191970;
|
||||
}
|
||||
.org-message-header-name {
|
||||
/* message-header-name */
|
||||
color: #6495ed;
|
||||
}
|
||||
.org-message-header-newsgroups {
|
||||
/* message-header-newsgroups */
|
||||
color: #00008b;
|
||||
font-weight: bold;
|
||||
font-style: italic;
|
||||
}
|
||||
.org-message-header-other {
|
||||
/* message-header-other */
|
||||
color: #4682b4;
|
||||
}
|
||||
.org-message-header-subject {
|
||||
/* message-header-subject */
|
||||
color: #000080;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-message-header-to {
|
||||
/* message-header-to */
|
||||
color: #191970;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-message-header-xheader {
|
||||
/* message-header-xheader */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-message-mml {
|
||||
/* message-mml */
|
||||
color: #228b22;
|
||||
}
|
||||
.org-message-separator {
|
||||
/* message-separator */
|
||||
color: #a52a2a;
|
||||
}
|
||||
.org-minibuffer-prompt {
|
||||
/* minibuffer-prompt */
|
||||
color: #0000cd;
|
||||
}
|
||||
.org-mm-uu-extract {
|
||||
/* mm-uu-extract */
|
||||
color: #006400;
|
||||
background-color: #ffffe0;
|
||||
}
|
||||
.org-mode-line {
|
||||
/* mode-line */
|
||||
color: #000000;
|
||||
background-color: #bfbfbf;
|
||||
}
|
||||
.org-mode-line-buffer-id {
|
||||
/* mode-line-buffer-id */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-mode-line-highlight {
|
||||
}
|
||||
.org-mode-line-inactive {
|
||||
/* mode-line-inactive */
|
||||
color: #333333;
|
||||
background-color: #e5e5e5;
|
||||
}
|
||||
.org-mouse {
|
||||
/* mouse */
|
||||
background-color: #000000;
|
||||
}
|
||||
.org-negation-char {
|
||||
}
|
||||
.org-next-error {
|
||||
/* next-error */
|
||||
background-color: #eedc82;
|
||||
}
|
||||
.org-nobreak-space {
|
||||
/* nobreak-space */
|
||||
color: #a52a2a;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-org-agenda-date {
|
||||
/* org-agenda-date */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-org-agenda-date-weekend {
|
||||
/* org-agenda-date-weekend */
|
||||
color: #0000ff;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-org-agenda-restriction-lock {
|
||||
/* org-agenda-restriction-lock */
|
||||
background-color: #ffff00;
|
||||
}
|
||||
.org-org-agenda-structure {
|
||||
/* org-agenda-structure */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-org-archived {
|
||||
/* org-archived */
|
||||
color: #7f7f7f;
|
||||
}
|
||||
.org-org-code {
|
||||
/* org-code */
|
||||
color: #7f7f7f;
|
||||
}
|
||||
.org-org-column {
|
||||
/* org-column */
|
||||
background-color: #e5e5e5;
|
||||
}
|
||||
.org-org-column-title {
|
||||
/* org-column-title */
|
||||
background-color: #e5e5e5;
|
||||
font-weight: bold;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-org-date {
|
||||
/* org-date */
|
||||
color: #a020f0;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-org-done {
|
||||
/* org-done */
|
||||
color: #228b22;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-org-drawer {
|
||||
/* org-drawer */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-org-ellipsis {
|
||||
/* org-ellipsis */
|
||||
color: #b8860b;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-org-formula {
|
||||
/* org-formula */
|
||||
color: #b22222;
|
||||
}
|
||||
.org-org-headline-done {
|
||||
/* org-headline-done */
|
||||
color: #bc8f8f;
|
||||
}
|
||||
.org-org-hide {
|
||||
/* org-hide */
|
||||
color: #e5e5e5;
|
||||
}
|
||||
.org-org-latex-and-export-specials {
|
||||
/* org-latex-and-export-specials */
|
||||
color: #8b4513;
|
||||
}
|
||||
.org-org-level-1 {
|
||||
/* org-level-1 */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-org-level-2 {
|
||||
/* org-level-2 */
|
||||
color: #b8860b;
|
||||
}
|
||||
.org-org-level-3 {
|
||||
/* org-level-3 */
|
||||
color: #a020f0;
|
||||
}
|
||||
.org-org-level-4 {
|
||||
/* org-level-4 */
|
||||
color: #b22222;
|
||||
}
|
||||
.org-org-level-5 {
|
||||
/* org-level-5 */
|
||||
color: #228b22;
|
||||
}
|
||||
.org-org-level-6 {
|
||||
/* org-level-6 */
|
||||
color: #5f9ea0;
|
||||
}
|
||||
.org-org-level-7 {
|
||||
/* org-level-7 */
|
||||
color: #da70d6;
|
||||
}
|
||||
.org-org-level-8 {
|
||||
/* org-level-8 */
|
||||
color: #bc8f8f;
|
||||
}
|
||||
.org-org-link {
|
||||
/* org-link */
|
||||
color: #a020f0;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-org-property-value {
|
||||
}
|
||||
.org-org-scheduled-previously {
|
||||
/* org-scheduled-previously */
|
||||
color: #b22222;
|
||||
}
|
||||
.org-org-scheduled-today {
|
||||
/* org-scheduled-today */
|
||||
color: #006400;
|
||||
}
|
||||
.org-org-sexp-date {
|
||||
/* org-sexp-date */
|
||||
color: #a020f0;
|
||||
}
|
||||
.org-org-special-keyword {
|
||||
/* org-special-keyword */
|
||||
color: #bc8f8f;
|
||||
}
|
||||
.org-org-table {
|
||||
/* org-table */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-org-tag {
|
||||
/* org-tag */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-org-target {
|
||||
/* org-target */
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-org-time-grid {
|
||||
/* org-time-grid */
|
||||
color: #b8860b;
|
||||
}
|
||||
.org-org-todo {
|
||||
/* org-todo */
|
||||
color: #ff0000;
|
||||
}
|
||||
.org-org-upcoming-deadline {
|
||||
/* org-upcoming-deadline */
|
||||
color: #b22222;
|
||||
}
|
||||
.org-org-verbatim {
|
||||
/* org-verbatim */
|
||||
color: #7f7f7f;
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-org-warning {
|
||||
/* org-warning */
|
||||
color: #ff0000;
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-outline-1 {
|
||||
/* outline-1 */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-outline-2 {
|
||||
/* outline-2 */
|
||||
color: #b8860b;
|
||||
}
|
||||
.org-outline-3 {
|
||||
/* outline-3 */
|
||||
color: #a020f0;
|
||||
}
|
||||
.org-outline-4 {
|
||||
/* outline-4 */
|
||||
color: #b22222;
|
||||
}
|
||||
.org-outline-5 {
|
||||
/* outline-5 */
|
||||
color: #228b22;
|
||||
}
|
||||
.org-outline-6 {
|
||||
/* outline-6 */
|
||||
color: #5f9ea0;
|
||||
}
|
||||
.org-outline-7 {
|
||||
/* outline-7 */
|
||||
color: #da70d6;
|
||||
}
|
||||
.org-outline-8 {
|
||||
/* outline-8 */
|
||||
color: #bc8f8f;
|
||||
}
|
||||
.outline-text-1, .outline-text-2, .outline-text-3, .outline-text-4, .outline-text-5, .outline-text-6 {
|
||||
/* Add more spacing between section. Padding, so that folding with org-info.js works as expected. */
|
||||
|
||||
}
|
||||
|
||||
.org-preprocessor {
|
||||
/* font-lock-preprocessor-face */
|
||||
color: #da70d6;
|
||||
}
|
||||
.org-query-replace {
|
||||
/* query-replace */
|
||||
color: #b0e2ff;
|
||||
background-color: #cd00cd;
|
||||
}
|
||||
.org-regexp-grouping-backslash {
|
||||
/* font-lock-regexp-grouping-backslash */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-regexp-grouping-construct {
|
||||
/* font-lock-regexp-grouping-construct */
|
||||
font-weight: bold;
|
||||
}
|
||||
.org-region {
|
||||
/* region */
|
||||
background-color: #eedc82;
|
||||
}
|
||||
.org-rmail-highlight {
|
||||
}
|
||||
.org-scroll-bar {
|
||||
/* scroll-bar */
|
||||
background-color: #bfbfbf;
|
||||
}
|
||||
.org-secondary-selection {
|
||||
/* secondary-selection */
|
||||
background-color: #ffff00;
|
||||
}
|
||||
.org-shadow {
|
||||
/* shadow */
|
||||
color: #7f7f7f;
|
||||
}
|
||||
.org-show-paren-match {
|
||||
/* show-paren-match */
|
||||
background-color: #40e0d0;
|
||||
}
|
||||
.org-show-paren-mismatch {
|
||||
/* show-paren-mismatch */
|
||||
color: #ffffff;
|
||||
background-color: #a020f0;
|
||||
}
|
||||
.org-string {
|
||||
/* font-lock-string-face */
|
||||
color: #bc8f8f;
|
||||
}
|
||||
.org-texinfo-heading {
|
||||
/* texinfo-heading */
|
||||
color: #0000ff;
|
||||
}
|
||||
.org-tool-bar {
|
||||
/* tool-bar */
|
||||
color: #000000;
|
||||
background-color: #bfbfbf;
|
||||
}
|
||||
.org-tooltip {
|
||||
/* tooltip */
|
||||
color: #000000;
|
||||
background-color: #ffffe0;
|
||||
}
|
||||
.org-trailing-whitespace {
|
||||
/* trailing-whitespace */
|
||||
background-color: #ff0000;
|
||||
}
|
||||
.org-type {
|
||||
/* font-lock-type-face */
|
||||
color: #228b22;
|
||||
}
|
||||
.org-underline {
|
||||
/* underline */
|
||||
text-decoration: underline;
|
||||
}
|
||||
.org-variable-name {
|
||||
/* font-lock-variable-name-face */
|
||||
color: #b8860b;
|
||||
}
|
||||
.org-variable-pitch {
|
||||
}
|
||||
.org-vertical-border {
|
||||
}
|
||||
.org-warning {
|
||||
/* font-lock-warning-face */
|
||||
color: #ff0000;
|
||||
font-weight: bold;
|
||||
}
|
||||
.rss_box {}
|
||||
.rss_title, rss_title a {}
|
||||
.rss_items {}
|
||||
.rss_item a:link, .rss_item a:visited, .rss_item a:active {}
|
||||
.rss_item a:hover {}
|
||||
.rss_date {}
|
||||
|
||||
pre.src {
|
||||
position: static;
|
||||
overflow: visible;
|
||||
padding-top: 1.2em;
|
||||
}
|
||||
|
||||
label.org-src-name {
|
||||
font-size: 80%;
|
||||
font-style: italic;
|
||||
}
|
||||
|
||||
#show_source {margin: 0; padding: 0;}
|
||||
|
||||
#postamble {
|
||||
font-size: 75%;
|
||||
min-width: 700px;
|
||||
max-width: 80%;
|
||||
line-height: 14pt;
|
||||
margin-left: 20px;
|
||||
margin-top: 10px;
|
||||
padding: .2em;
|
||||
background-color: #ffffff;
|
||||
z-index: -1000;
|
||||
}
|
||||
|
||||
|
||||
} /* END OF @media all */
|
||||
|
||||
@media screen
|
||||
{
|
||||
#table-of-contents {
|
||||
position: fixed;
|
||||
margin-top: 105px;
|
||||
float: right;
|
||||
border: 1px solid #red;
|
||||
max-width: 50%;
|
||||
overflow: auto;
|
||||
}
|
||||
} /* END OF @media screen */
|
16
docs/theme.setup
Normal file
16
docs/theme.setup
Normal file
@ -0,0 +1,16 @@
|
||||
# -*- mode: org; -*-
|
||||
|
||||
#+HTML_LINK_HOME: index.html
|
||||
#+OPTIONS: H:4 num:t toc:t \n:nil @:t ::t |:t ^:t -:t f:t *:t <:t d:(HIDE)
|
||||
|
||||
# SETUPFILE: ../docs/org-html-themes/org/theme-readtheorg.setup
|
||||
|
||||
#+INFOJS_OPT: toc:t mouse:underline path:org-info.js
|
||||
#+HTML_HEAD: <link rel="stylesheet" title="Standard" href="qmckl.css" type="text/css" />
|
||||
|
||||
#+STARTUP: align fold nodlcheck hidestars oddeven lognotestate
|
||||
#+AUTHOR: TREX CoE
|
||||
#+LANGUAGE: en
|
||||
|
||||
|
||||
|
1
include/.gitignore
vendored
Normal file
1
include/.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
||||
|
2
lib/.gitignore
vendored
Normal file
2
lib/.gitignore
vendored
Normal file
@ -0,0 +1,2 @@
|
||||
libqmckl.so
|
||||
libqmckl.a
|
0
man/.gitignore
vendored
Normal file
0
man/.gitignore
vendored
Normal file
1
share/qmckl/fortran/.gitignore
vendored
Normal file
1
share/qmckl/fortran/.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
||||
qmckl_f.f90
|
125
src/Makefile
125
src/Makefile
@ -1,66 +1,135 @@
|
||||
# Header :noexport:
|
||||
|
||||
|
||||
# This file was created by tools/Building.org
|
||||
|
||||
.POSIX:
|
||||
|
||||
# Dependencies
|
||||
|
||||
|
||||
LIBS=-lpthread
|
||||
|
||||
# Variables
|
||||
|
||||
|
||||
QMCKL_ROOT=$(shell dirname $(CURDIR))
|
||||
|
||||
shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so
|
||||
static_lib=$(QMCKL_ROOT)/lib/libqmckl.a
|
||||
qmckl_h=$(QMCKL_ROOT)/include/qmckl.h
|
||||
qmckl_f=$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90
|
||||
|
||||
export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT
|
||||
|
||||
ORG_SOURCE_FILES=$(wildcard *.org)
|
||||
C_SOURCE_FILES=$(patsubst %.org,%.c,$(ORG_SOURCE_FILES))
|
||||
INCLUDE=-I$(QMCKL_ROOT)/include/
|
||||
|
||||
# Compiler options
|
||||
|
||||
# GNU, Intel and LLVM compilers are supported. Choose here:
|
||||
|
||||
|
||||
COMPILER=GNU
|
||||
#COMPILER=INTEL
|
||||
#COMPILER=LLVM
|
||||
|
||||
# GNU
|
||||
|
||||
|
||||
ifeq ($(COMPILER),GNU)
|
||||
#----------------------------------------------------------
|
||||
CC=gcc -g
|
||||
CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra
|
||||
CFLAGS=-fPIC $(INCLUDE) \
|
||||
-fexceptions -Wall -Werror -Wpedantic -Wextra -fmax-errors=3
|
||||
|
||||
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
|
||||
FFLAGS=-fPIC $(INCLUDE) \
|
||||
-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising \
|
||||
-Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation \
|
||||
-Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \
|
||||
-ffpe-trap=zero,overflow,underflow
|
||||
|
||||
LIBS=-lgfortran -lm
|
||||
LIBS+=-lgfortran -lm
|
||||
#----------------------------------------------------------
|
||||
endif
|
||||
|
||||
# Intel
|
||||
|
||||
|
||||
ifeq ($(COMPILER),INTEL)
|
||||
#----------------------------------------------------------
|
||||
CC=icc -xHost
|
||||
CFLAGS=-fPIC -g -O2
|
||||
CFLAGS=-fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
FC=ifort -xHost
|
||||
FFLAGS=-fPIC -g -O2
|
||||
FFLAGS=-fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
LIBS=-lm -lifcore -lirc
|
||||
LIBS+=-lm -lifcore -lirc
|
||||
#----------------------------------------------------------
|
||||
CC=icc -xHost
|
||||
endif
|
||||
|
||||
#TODO
|
||||
# LLVM
|
||||
|
||||
|
||||
ifeq ($(COMPILER),LLVM)
|
||||
#----------------------------------------------------------
|
||||
CC=clang
|
||||
CFLAGS=-fPIC -g -O2
|
||||
CFLAGS=-fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
FC=flang
|
||||
FFLAGS=fPIC -g -O2
|
||||
FFLAGS=fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
LIBS=-lm
|
||||
LIBS+=-lm
|
||||
#----------------------------------------------------------
|
||||
endif
|
||||
|
||||
# Rules
|
||||
|
||||
export CC CFLAGS FC FFLAGS LIBS
|
||||
# The source files are created during the generation of the file ~Makefile.generated~.
|
||||
# The Makefile.generated is the one that will be distributed with the library.
|
||||
|
||||
MERGED_ORG=merged_qmckl.org
|
||||
ORG_SOURCE_FILES=$(wildcard *.org)
|
||||
OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE_FILES)))
|
||||
|
||||
.PHONY: clean
|
||||
.PHONY: clean shared static doc all check install uninstall syntax
|
||||
.SECONDARY: # Needed to keep the produced C and Fortran files
|
||||
|
||||
libqmckl.so: Makefile.generated
|
||||
$(MAKE) -f Makefile.generated
|
||||
$(shared_lib) $(static_lib) install uninstall: $(qmckl_h) $(qmckl_f) Makefile.generated
|
||||
$(MAKE) -f Makefile.generated $@
|
||||
|
||||
test: Makefile.generated
|
||||
$(MAKE) -f Makefile.generated test
|
||||
$(qmckl_f) $(qmckl_h): Makefile.generated
|
||||
$(QMCKL_ROOT)/tools/build_qmckl_h.sh
|
||||
|
||||
shared: $(shared_lib)
|
||||
static: $(static_lib)
|
||||
all: shared static doc check
|
||||
|
||||
check: $(static_lib)
|
||||
$(MAKE) -f Makefile.generated check
|
||||
|
||||
syntax:
|
||||
cppcheck --addon=cert qmckl_*.c
|
||||
|
||||
doc: $(ORG_SOURCE_FILES)
|
||||
./merge_org.sh
|
||||
./create_doc.sh $(MERGED_ORG)
|
||||
rm $(MERGED_ORG)
|
||||
|
||||
$(QMCKL_ROOT)/tools/build_doc.sh
|
||||
|
||||
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
|
||||
- $(MAKE) -f Makefile.generated clean
|
||||
- $(RM) test_qmckl_* test_qmckl.c \
|
||||
$(qmckl_h) $(qmckl_f) \
|
||||
qmckl_*.f90 qmckl_*.c qmckl_*.h \
|
||||
Makefile.generated *.html *.txt
|
||||
|
||||
Makefile.generated: Makefile create_makefile.sh $(ORG_SOURCE_FILES)
|
||||
./merge_org.sh
|
||||
./create_makefile.sh $(MERGED_ORG)
|
||||
rm $(MERGED_ORG)
|
||||
veryclean: clean FORCE
|
||||
- $(RM) $(QMCKL_ROOT)/docs/*.html \
|
||||
$(QMCKL_ROOT)/docs/*.txt
|
||||
|
||||
Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES)
|
||||
$(QMCKL_ROOT)/tools/create_makefile.sh
|
||||
|
||||
|
||||
.SUFFIXES: .org .c
|
||||
|
||||
.org.c:
|
||||
$(QMCKL_ROOT)/tools/tangle.sh $<
|
||||
|
255
src/README.org
255
src/README.org
@ -1,207 +1,68 @@
|
||||
#+TITLE: QMCkl source code documentation
|
||||
#+EXPORT_FILE_NAME: index.html
|
||||
#+PROPERTY: comments org
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
|
||||
#+SETUPFILE: https://fniessen.github.io/org-html-themes/setup/theme-readtheorg.setup
|
||||
------------------
|
||||
|
||||
* Introduction
|
||||
|
||||
The ultimate goal of QMCkl is to provide a high-performance
|
||||
#+begin_comment
|
||||
The .org files is included here in the order specified in the
|
||||
table_of_contents file.
|
||||
#+end_comment
|
||||
|
||||
#+NAME: toc
|
||||
#+begin_src sh :exports none
|
||||
grep TITLE $(cat table_of_contents) | tr ':' ' '
|
||||
#+end_src
|
||||
|
||||
#+RESULTS: toc
|
||||
| qmckl.org | #+TITLE | Header | files |
|
||||
| qmckl_error.org | #+TITLE | Error | handling |
|
||||
| qmckl_context.org | #+TITLE | Context | |
|
||||
| qmckl_precision.org | #+TITLE | Multi-precision | |
|
||||
| qmckl_memory.org | #+TITLE | Memory | management |
|
||||
| qmckl_distance.org | #+TITLE | Distances | |
|
||||
| qmckl_ao.org | #+TITLE | Atomic | Orbitals |
|
||||
| test_qmckl.org | #+TITLE | Testing | |
|
||||
|
||||
#+begin_src python :var data=toc :exports results :results raw
|
||||
result = []
|
||||
for row in data:
|
||||
filename = row[0].split('.')[0] + ".html"
|
||||
title = ' '.join(row[2:]).strip()
|
||||
result += [ f" - [[./{filename}][{title}]]" ]
|
||||
return '\n'.join(result)
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
- [[./qmckl.html][Introduction]]
|
||||
- [[./qmckl_error.html][Error handling]]
|
||||
- [[./qmckl_context.html][Context]]
|
||||
- [[./qmckl_precision.html][Multi-precision]]
|
||||
- [[./qmckl_memory.html][Memory management]]
|
||||
- [[./qmckl_distance.html][Distances]]
|
||||
- [[./qmckl_ao.html][Atomic Orbitals]]
|
||||
- [[./test_qmckl.html][Testing]]
|
||||
|
||||
|
||||
--------------------------------
|
||||
|
||||
|
||||
The ultimate goal of the QMCkl library 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.
|
||||
implementation of the library, 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
|
||||
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 source code of the library is available at
|
||||
https://github.com/trex-coe/qmckl
|
||||
and bug reports should be submitted at
|
||||
https://github.com/trex-coe/qmckl/issues.
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
set -e
|
||||
|
||||
nb=$(basename $1 .ipynb)
|
||||
jupyter nbconvert --to markdown ${nb}.ipynb --output ${nb}.md
|
||||
pandoc ${nb}.md -o ${nb}.org
|
||||
rm ${nb}.md
|
||||
#+END_SRC
|
||||
|
||||
And pandoc can convert multiple markdown formats into org-mode.
|
||||
|
||||
** 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 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]].
|
||||
|
||||
** 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=
|
||||
|
||||
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:
|
||||
|
||||
- 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.
|
||||
|
||||
# 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 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.
|
||||
|
||||
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).
|
||||
|
||||
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
|
||||
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.
|
||||
|
||||
** 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
|
||||
[[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.
|
||||
|
||||
# -*- mode: org -*-
|
||||
|
||||
|
@ -1,13 +0,0 @@
|
||||
#!/bin/bash
|
||||
INPUT=$1
|
||||
|
||||
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
|
||||
|
||||
|
@ -1,95 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
INPUT=$1
|
||||
OUTPUT=Makefile.generated
|
||||
|
||||
# Tangle org files
|
||||
emacs \
|
||||
$INPUT \
|
||||
--batch \
|
||||
-f org-babel-tangle \
|
||||
--kill
|
||||
|
||||
|
||||
|
||||
# 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
|
||||
|
||||
TESTS=""
|
||||
for i in $(ls test_qmckl_*.c) ; do
|
||||
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
|
||||
|
||||
cat << EOF > $OUTPUT
|
||||
CC=$CC
|
||||
CFLAGS=$CFLAGS -I../munit/
|
||||
|
||||
FC=$FC
|
||||
FFLAGS=$FFLAGS
|
||||
OBJECT_FILES=$OBJECTS
|
||||
TESTS=$TESTS
|
||||
TESTS_F=$TESTS_F
|
||||
|
||||
LIBS=$LIBS
|
||||
|
||||
libqmckl.so: \$(OBJECT_FILES)
|
||||
\$(CC) -shared \$(OBJECT_FILES) -o libqmckl.so
|
||||
|
||||
%.o: %.c
|
||||
\$(CC) \$(CFLAGS) -c \$*.c -o \$*.o
|
||||
|
||||
%.o: %.f90 qmckl_f.o
|
||||
\$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o
|
||||
|
||||
test_qmckl: test_qmckl.c libqmckl.so \$(TESTS) \$(TESTS_F)
|
||||
\$(CC) \$(CFLAGS) -Wl,-rpath,$PWD -L. \
|
||||
../munit/munit.c \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o test_qmckl
|
||||
|
||||
test: test_qmckl
|
||||
./test_qmckl
|
||||
|
||||
.PHONY: test
|
||||
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
|
||||
|
||||
for i in $(ls test_qmckl_*.c) ; do
|
||||
FILE=${i%.c}
|
||||
echo "${FILE}.o: ${FILE}.c qmckl.h"
|
||||
done >> $OUTPUT
|
||||
|
||||
|
||||
for i in $(ls test_qmckl*.f90) ; do
|
||||
FILE=${i%.f90}
|
||||
echo "${FILE}.o: ${FILE}.f90"
|
||||
done >> $OUTPUT
|
||||
|
||||
|
521
src/hpc/qmckl_tile.org
Normal file
521
src/hpc/qmckl_tile.org
Normal file
@ -0,0 +1,521 @@
|
||||
#+TITLE: Tiled arrays
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
|
||||
To increase performance, matrices may be stored as tiled
|
||||
arrays. Instead of storing a matrix in a two-dimensional array, it may
|
||||
be stored as a two dimensional array of small matrices (a rank 4
|
||||
tensor). This improves the locality of the data in matrix
|
||||
multiplications, and also enables the possibility to use BLAS3
|
||||
while also exploiting part of the sparse structure of the matrices.
|
||||
|
||||
Tile
|
||||
│ ┌──────┬──────┬──────┐
|
||||
│ │1 4 7 │ │ │
|
||||
└───────►│2 5 8 │ T_12 │ T_13 │
|
||||
│3 6 9 │ │ │
|
||||
├──────┼──────┼──────┤
|
||||
│ │ │ │
|
||||
│ T_21 │ T_22 │ T_23 │
|
||||
│ │ │ │
|
||||
├──────┼──────┼──────┤
|
||||
│ │ │ │
|
||||
│ T_31 │ T_32 │ T_33 │
|
||||
│ │ │ │
|
||||
└──────┴──────┴──────┘
|
||||
|
||||
In this file, tiled matrice will be produced for the following
|
||||
types:
|
||||
|
||||
#+NAME: types
|
||||
| float |
|
||||
| double |
|
||||
|
||||
* Headers :noexport:
|
||||
|
||||
#+NAME: filename
|
||||
#+begin_src elisp :tangle no
|
||||
(file-name-nondirectory (substring buffer-file-name 0 -4))
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#ifndef QMCKL_TILE_HPT
|
||||
#define QMCKL_TILE_HPT
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
MunitResult test_<<filename()>>() {
|
||||
qmckl_context context;
|
||||
context = qmckl_context_create();
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
#include <limits.h>
|
||||
|
||||
#include "qmckl_context_type.h"
|
||||
#include "qmckl_error_type.h"
|
||||
#include "qmckl_memory_private_type.h"
|
||||
#include "qmckl_tile_private_type.h"
|
||||
|
||||
#include "qmckl_context_func.h"
|
||||
#include "qmckl_error_func.h"
|
||||
#include "qmckl_memory_private_func.h"
|
||||
#include "qmckl_tile_private_func.h"
|
||||
#+end_src
|
||||
|
||||
* Data structures
|
||||
|
||||
** Tile
|
||||
|
||||
A tile is a small matrix of fixed size. The dimensions of the
|
||||
tiles is fixed at compile-time to increase performance. It is
|
||||
defined as $2^s$:
|
||||
|
||||
| s | tile size |
|
||||
|---+-----------|
|
||||
| 2 | 4 |
|
||||
| 3 | 8 |
|
||||
| 4 | 16 |
|
||||
| 5 | 32 |
|
||||
| 6 | 64 |
|
||||
| 7 | 128 |
|
||||
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#define TILE_SIZE_SHIFT 3
|
||||
#define TILE_SIZE 8
|
||||
#define VEC_SIZE 8
|
||||
#+end_src
|
||||
|
||||
|
||||
#+NAME: tile_hpt
|
||||
#+begin_src c
|
||||
typedef struct $T$_tile_struct {
|
||||
$T$ element[TILE_SIZE][TILE_SIZE];
|
||||
int64_t is_null;
|
||||
int64_t padding[VEC_SIZE-1];
|
||||
} $T$_tile_struct;
|
||||
#+end_src
|
||||
|
||||
** Tiled matrix
|
||||
|
||||
A tiled matrix is a two-dimensional array of tiles.
|
||||
|
||||
#+NAME: matrix_hpt
|
||||
#+begin_src c
|
||||
typedef struct $T$_tiled_matrix {
|
||||
$T$_tile_struct** tile;
|
||||
size_t n_row;
|
||||
size_t n_col;
|
||||
size_t n_tile_row;
|
||||
size_t n_tile_col;
|
||||
} $T$_tiled_matrix;
|
||||
#+end_src
|
||||
|
||||
When a tiled matrix is initialized, it is set to zero.
|
||||
|
||||
#+NAME: init_hpf
|
||||
#+begin_src c
|
||||
qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context,
|
||||
$T$_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col);
|
||||
#+end_src
|
||||
|
||||
#+NAME: init_c
|
||||
#+begin_src c
|
||||
qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context,
|
||||
$T$_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
} $T$_tiled_matrix;
|
||||
#+end_src
|
||||
|
||||
When a tiled matrix is initialized, it is set to zero.
|
||||
|
||||
#+NAME: init_hpf
|
||||
#+begin_src c
|
||||
qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context,
|
||||
$T$_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col);
|
||||
#+end_src
|
||||
|
||||
#+NAME: init_c
|
||||
#+begin_src c
|
||||
qmckl_exit_code $T$_tiled_matrix_init (qmckl_context context,
|
||||
$T$_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
}
|
||||
|
||||
if (m == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"$T$_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (n_tile_row == (size_t) 0) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_3,
|
||||
"$T$_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (n_tile_col == (size_t) 0) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_4,
|
||||
"$T$_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
qmckl_memory_info_struct info = qmckl_memory_info_struct_zero;
|
||||
size_t n = n_tile_row * n_tile_col;
|
||||
|
||||
/* Check overflow */
|
||||
if (n/n_tile_col != n_tile_row
|
||||
|| n > SIZE_MAX / sizeof($T$_tile_struct) ) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"$T$_tiled_matrix_init",
|
||||
"n_tile_row * n_tile_col overflows" );
|
||||
}
|
||||
|
||||
/* Allocate array of column pointers */
|
||||
info.size = n_tile_col * sizeof($T$_tile_struct*) ;
|
||||
m->tile = ($T$_tile_struct**) qmckl_malloc(context, info);
|
||||
|
||||
if (m->tile == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"$T$_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
|
||||
/* Allocate array of tiles */
|
||||
info.size = n * sizeof($T$_tile_struct) ;
|
||||
m->tile[0] = ($T$_tile_struct*) qmckl_malloc(context, info);
|
||||
|
||||
if (m->tile[0] == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"$T$_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
/* Compute array of pointers to the 1st element of columns */
|
||||
for (size_t i=1 ; i<n_tile_col ; ++i) {
|
||||
m->tile[i] = m->tile[i-1] + n_tile_row;
|
||||
}
|
||||
|
||||
m->n_tile_row = n_tile_row;
|
||||
m->n_tile_col = n_tile_col;
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
#+end_src
|
||||
|
||||
* Write templates
|
||||
|
||||
#+begin_src python :noweb yes :results drawer :var types=types :exports results
|
||||
def generate(f, text):
|
||||
result = [ f"#+begin_src c :tangle (eval {f})" ]
|
||||
for t in types:
|
||||
t=t[0]
|
||||
result += [ text.replace("$T$",t), "" ]
|
||||
|
||||
result += [ "#+end_src" ]
|
||||
return '\n'.join(result)
|
||||
|
||||
return '\n'.join( [ ""
|
||||
|
||||
, generate("h_private_type", """
|
||||
<<tile_hpt>>
|
||||
|
||||
<<matrix_hpt>>
|
||||
""")
|
||||
|
||||
, ""
|
||||
|
||||
, generate("h_private_func", """
|
||||
<<init_hpf>>
|
||||
""")
|
||||
|
||||
, ""
|
||||
|
||||
, generate("c", """
|
||||
<<init_c>>
|
||||
""")
|
||||
|
||||
] )
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
:results:
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
|
||||
typedef struct float_tile_struct {
|
||||
float element[TILE_SIZE][TILE_SIZE];
|
||||
int32_t is_null;
|
||||
int32_t padding;
|
||||
} float_tile_struct;
|
||||
|
||||
typedef struct float_tiled_matrix {
|
||||
float_tile_struct** tile;
|
||||
size_t n_tile_row;
|
||||
size_t n_tile_col;
|
||||
} float_tiled_matrix;
|
||||
|
||||
|
||||
|
||||
typedef struct double_tile_struct {
|
||||
double element[TILE_SIZE][TILE_SIZE];
|
||||
int32_t is_null;
|
||||
int32_t padding;
|
||||
} double_tile_struct;
|
||||
|
||||
typedef struct double_tiled_matrix {
|
||||
double_tile_struct** tile;
|
||||
size_t n_tile_row;
|
||||
size_t n_tile_col;
|
||||
} double_tiled_matrix;
|
||||
|
||||
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval h_private_func)
|
||||
|
||||
qmckl_exit_code float_tiled_matrix_init (qmckl_context context,
|
||||
float_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col);
|
||||
|
||||
|
||||
|
||||
qmckl_exit_code double_tiled_matrix_init (qmckl_context context,
|
||||
double_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col);
|
||||
|
||||
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
|
||||
qmckl_exit_code float_tiled_matrix_init (qmckl_context context,
|
||||
float_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
}
|
||||
|
||||
if (m == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"float_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (n_tile_row == (size_t) 0) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_3,
|
||||
"float_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (n_tile_col == (size_t) 0) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_4,
|
||||
"float_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
qmckl_memory_info_struct info = qmckl_memory_info_struct_zero;
|
||||
size_t n = n_tile_row * n_tile_col;
|
||||
|
||||
/* Check overflow */
|
||||
if (n/n_tile_col != n_tile_row
|
||||
|| n > SIZE_MAX / sizeof(float_tile_struct) ) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"float_tiled_matrix_init",
|
||||
"n_tile_row * n_tile_col overflows" );
|
||||
}
|
||||
|
||||
/* Allocate array of column pointers */
|
||||
info.size = n_tile_col * sizeof(float_tile_struct*) ;
|
||||
m->tile = (float_tile_struct**) qmckl_malloc(context, info);
|
||||
|
||||
if (m->tile == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"float_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
|
||||
/* Allocate array of tiles */
|
||||
info.size = n * sizeof(float_tile_struct) ;
|
||||
m->tile[0] = (float_tile_struct*) qmckl_malloc(context, info);
|
||||
|
||||
if (m->tile[0] == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"float_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
/* Compute array of pointers to the 1st element of columns */
|
||||
for (size_t i=1 ; i<n_tile_col ; ++i) {
|
||||
m->tile[i] = m->tile[i-1] + n_tile_row;
|
||||
}
|
||||
|
||||
m->n_tile_row = n_tile_row;
|
||||
m->n_tile_col = n_tile_col;
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
qmckl_exit_code double_tiled_matrix_init (qmckl_context context,
|
||||
double_tiled_matrix* m,
|
||||
size_t n_tile_row,
|
||||
size_t n_tile_col) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
}
|
||||
|
||||
if (m == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"double_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (n_tile_row == (size_t) 0) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_3,
|
||||
"double_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (n_tile_col == (size_t) 0) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_4,
|
||||
"double_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
qmckl_memory_info_struct info = qmckl_memory_info_struct_zero;
|
||||
size_t n = n_tile_row * n_tile_col;
|
||||
|
||||
/* Check overflow */
|
||||
if (n/n_tile_col != n_tile_row
|
||||
|| n > SIZE_MAX / sizeof(double_tile_struct) ) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"double_tiled_matrix_init",
|
||||
"n_tile_row * n_tile_col overflows" );
|
||||
}
|
||||
|
||||
/* Allocate array of column pointers */
|
||||
info.size = n_tile_col * sizeof(double_tile_struct*) ;
|
||||
m->tile = (double_tile_struct**) qmckl_malloc(context, info);
|
||||
|
||||
if (m->tile == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"double_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
|
||||
/* Allocate array of tiles */
|
||||
info.size = n * sizeof(double_tile_struct) ;
|
||||
m->tile[0] = (double_tile_struct*) qmckl_malloc(context, info);
|
||||
|
||||
if (m->tile[0] == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"double_tiled_matrix_init",
|
||||
NULL);
|
||||
}
|
||||
|
||||
/* Compute array of pointers to the 1st element of columns */
|
||||
for (size_t i=1 ; i<n_tile_col ; ++i) {
|
||||
m->tile[i] = m->tile[i-1] + n_tile_row;
|
||||
}
|
||||
|
||||
m->n_tile_row = n_tile_row;
|
||||
m->n_tile_col = n_tile_col;
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
|
||||
#+end_src
|
||||
:end:
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
if (qmckl_context_destroy(context) != QMCKL_SUCCESS)
|
||||
return QMCKL_FAILURE;
|
||||
return MUNIT_OK;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
**✸ Compute file names
|
||||
#+begin_src emacs-lisp
|
||||
; The following is required to compute the file names
|
||||
|
||||
(setq pwd (file-name-directory buffer-file-name))
|
||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||||
(setq f (concat pwd name "_f.f90"))
|
||||
(setq fh (concat pwd name "_fh.f90"))
|
||||
(setq c (concat pwd name ".c"))
|
||||
(setq h (concat name ".h"))
|
||||
(setq h_private (concat name "_private.h"))
|
||||
(setq c_test (concat pwd "test_" name ".c"))
|
||||
(setq f_test (concat pwd "test_" name "_f.f90"))
|
||||
|
||||
; Minted
|
||||
(require 'ox-latex)
|
||||
(setq org-latex-listings 'minted)
|
||||
(add-to-list 'org-latex-packages-alist '("" "listings"))
|
||||
(add-to-list 'org-latex-packages-alist '("" "color"))
|
||||
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
| | color |
|
||||
| | listings |
|
||||
|
||||
|
||||
# -*- mode: org -*-
|
||||
# vim: syntax=c
|
||||
|
||||
|
@ -1,13 +0,0 @@
|
||||
#!/bin/bash
|
||||
|
||||
for i in README.org \
|
||||
qmckl.org \
|
||||
qmckl_memory.org \
|
||||
qmckl_context.org \
|
||||
qmckl_distance.org \
|
||||
qmckl_ao.org \
|
||||
qmckl_footer.org \
|
||||
test_qmckl.org
|
||||
do
|
||||
cat $i >> merged_qmckl.org
|
||||
done
|
298
src/qmckl.org
298
src/qmckl.org
@ -1,64 +1,266 @@
|
||||
** =qmckl.h= header file
|
||||
#+TITLE: Introduction
|
||||
#+PROPERTY: comments org
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
# -*- mode: org -*-
|
||||
|
||||
This file produces the =qmckl.h= header file, which is to be included
|
||||
when qmckl functions are used.
|
||||
* Using QMCkl
|
||||
|
||||
We also create here the =qmckl_f.f90= which is the Fortran interface file.
|
||||
The =qmckl.h= header file installed in the =${prefix}/include= directory
|
||||
has to be included in C codes when QMCkl functions are used:
|
||||
|
||||
*** Top of header files :noexport:
|
||||
|
||||
#+BEGIN_SRC C :tangle qmckl.h
|
||||
#ifndef QMCKL_H
|
||||
#define QMCKL_H
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <math.h>
|
||||
#+END_SRC
|
||||
#+begin_src c :tangle no
|
||||
#include "qmckl.h"
|
||||
#+end_src
|
||||
|
||||
#+BEGIN_SRC f90 :tangle qmckl_f.f90
|
||||
module qmckl
|
||||
use, intrinsic :: iso_c_binding
|
||||
#+END_SRC
|
||||
In Fortran programs, the =qmckl_f.f90= installed in
|
||||
=${prefix}/share/qmckl/fortran= interface file should be copied in the source
|
||||
code using the library, and the Fortran codes should use the ~qmckl~ module as
|
||||
|
||||
The bottoms of the files are located in the [[qmckl_footer.org]] file.
|
||||
|
||||
*** Constants
|
||||
#+begin_src f90 :tangle no
|
||||
use qmckl
|
||||
#+end_src
|
||||
|
||||
**** Success/failure
|
||||
Both files are located in the =include/= directory.
|
||||
|
||||
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=.
|
||||
* Developing in QMCkl
|
||||
|
||||
#+BEGIN_SRC C :comments org :tangle qmckl.h
|
||||
#define QMCKL_SUCCESS 0
|
||||
#define QMCKL_FAILURE 1
|
||||
** Literate programming
|
||||
|
||||
typedef int32_t qmckl_exit_code;
|
||||
typedef int64_t qmckl_context ;
|
||||
In a traditional source code, most of the lines of source files of a program
|
||||
are code, scripts, Makefiles, and only a few lines are comments explaining
|
||||
parts of the code that are non-trivial to understand. The documentation of
|
||||
the prorgam is usually written in a separate directory, and is often outdated
|
||||
compared to the code.
|
||||
|
||||
#+END_SRC
|
||||
Literate programming is a different approach to programming,
|
||||
where the program is considered as a publishable-quality document. Most of
|
||||
the lines of the source files are text, mathematical formulas, tables,
|
||||
figures, /etc/, and the lines of code are just the translation in a computer
|
||||
language of the ideas and algorithms expressed in the text. More importantly,
|
||||
the "document" is structured like a text document with sections, subsections,
|
||||
a bibliography, a table of contents /etc/, and the place where pieces of code
|
||||
appear are the places where they should belong for the reader to understand
|
||||
the logic of the program, not the places where the compiler expects to find
|
||||
them. Both the publishable-quality document and the binary executable are
|
||||
produced from the same source files.
|
||||
|
||||
#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
|
||||
integer, parameter :: QMCKL_SUCCESS = 0
|
||||
integer, parameter :: QMCKL_FAILURE = 0
|
||||
#+END_SRC
|
||||
Literate programming is particularly well adapted in this context, as the
|
||||
central part of this project is the documentation of an API. The
|
||||
implementation of the algorithms is just an expression of the algorithms in a
|
||||
language that can be compiled, so that the correctness of the algorithms can
|
||||
be tested.
|
||||
|
||||
**** Precision-related constants
|
||||
We have chosen to write the source files in [[https://karl-voit.at/2017/09/23/orgmode-as-markup-only/][org-mode]] format,
|
||||
as any text editor can be used to edit org-mode files. To
|
||||
produce the documentation, there exists multiple possibilities to convert
|
||||
org-mode files into different formats such as HTML or PDF. The source code is
|
||||
easily extracted from the org-mode files invoking the Emacs text editor from
|
||||
the command-line in the =Makefile=, and then the produced files are compiled.
|
||||
Moreover, within the Emacs text editor the source code blocks can be executed
|
||||
interactively, in the same spirit as Jupyter notebooks.
|
||||
|
||||
Controlling numerical precision enables optimizations. Here, the
|
||||
default parameters determining the target numerical precision and
|
||||
range are defined.
|
||||
** Source code editing
|
||||
|
||||
#+BEGIN_SRC C :comments org :tangle qmckl.h
|
||||
#define QMCKL_DEFAULT_PRECISION 53
|
||||
#define QMCKL_DEFAULT_RANGE 11
|
||||
#+END_SRC
|
||||
For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]].
|
||||
|
||||
#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
|
||||
integer, parameter :: QMCKL_DEFAULT_PRECISION = 53
|
||||
integer, parameter :: QMCKL_DEFAULT_RANGE = 11
|
||||
#+END_SRC
|
||||
|
||||
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.
|
||||
|
||||
In the =tools/init.el= file, we provide a minimal Emacs configuration
|
||||
file for vim users. This file should be copied into =.emacs.d/init.el=.
|
||||
|
||||
For users with a preference for Jupyter notebooks, we also provide the
|
||||
=tools/nb_to_org.sh= script can convert jupyter notebooks into org-mode
|
||||
files.
|
||||
|
||||
Note that pandoc can be used to convert multiple markdown formats into
|
||||
org-mode.
|
||||
|
||||
** Choice of the programming language
|
||||
|
||||
Most of the codes of the [[https://trex-coe.eu][TREX CoE]] are written in Fortran with some scripts in
|
||||
Bash and Python. Outside of the CoE, Fortran is also important (Casino, Amolqc),
|
||||
and other important languages used by the community are C and C++ (QMCPack,
|
||||
QWalk), and Julia is gaining in popularity. The library we design should be
|
||||
compatible with all of these languages. The QMCkl API has to be compatible
|
||||
with the C language since libraries with a C-compatible API can be used in
|
||||
every other language.
|
||||
|
||||
High-performance versions of the QMCkl, with the same API, will be rewritten by
|
||||
the experts in HPC. These optimized libraries will be tuned for specific
|
||||
architectures, among which we can cite x86 based processors, and GPU
|
||||
accelerators. Nowadays, the most efficient software tools to take advantage of
|
||||
low-level features of the processor (intrinsics) and of GPUs are for C++
|
||||
developers. It is highly probable that the optimized implementations will be
|
||||
written in C++, and this is agreement with our choice to make the API
|
||||
C-compatible.
|
||||
|
||||
Fortran is one of the most common languages used by the community, and is simple
|
||||
enough to make the algorithms readable both by experts in QMC, and experts in
|
||||
HPC. Hence we propose in this pedagogical implementation of QMCkl to use Fortran
|
||||
to express the QMC algorithms. As the main languages of the library is C, this
|
||||
implies that the exposed C functions call the Fortran routine. However, for
|
||||
internal functions related to system programming, the C language is more natural
|
||||
than Fortran.
|
||||
|
||||
The Fortran source files should provide a C interface using the
|
||||
~iso_c_binding~ module. 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=.
|
||||
|
||||
For more guidelines on using Fortran to generate a C interface, see
|
||||
[[http://fortranwiki.org/fortran/show/Generating+C+Interfaces][this link]].
|
||||
|
||||
** Coding rules
|
||||
|
||||
The authors should follow the recommendations of the C99
|
||||
[[https://wiki.sei.cmu.edu/confluence/display/c/SEI+CERT+C+Coding+Standard][SEI+CERT C Coding Standard]].
|
||||
|
||||
Compliance can be checked with =cppcheck= as:
|
||||
|
||||
#+begin_src bash
|
||||
cppcheck --addon=cert --enable=all *.c &> cppcheck.out
|
||||
#+end_src
|
||||
|
||||
** Design of the library
|
||||
|
||||
The proposed API should allow the library to: deal with memory transfers
|
||||
between CPU and accelerators, and to use different levels of floating-point
|
||||
precision. We chose a multi-layered design with low-level and high-level
|
||||
functions (see below).
|
||||
|
||||
** Naming conventions
|
||||
|
||||
To avoid namespace collisions, we use =qmckl_= as a prefix for all exported
|
||||
functions and variables. All exported header files should have a file name
|
||||
prefixed with =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 file 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
|
||||
|
||||
In the C language, the number of bits used by the integer types can change
|
||||
from one architecture to another one. To circumvent this problem, we choose to
|
||||
use the integer types defined in ~<stdint.h>~ where the number of bits used for
|
||||
the integers are fixed.
|
||||
|
||||
To ensure that the library will be easily usable in /any/ other language
|
||||
than C, we restrict the data types in the interfaces to the following:
|
||||
- 32-bit and 64-bit integers, scalars and and arrays (~int32_t~ and ~int64_t~)
|
||||
- 32-bit and 64-bit floats, scalars and and arrays (~float~ and ~double~)
|
||||
- Pointers are always casted into 64-bit integers, even on legacy 32-bit architectures
|
||||
- ASCII strings are represented as a pointers to character arrays
|
||||
and terminated by a ~'\0'~ character (C convention).
|
||||
- Complex numbers can be represented by an array of 2 floats.
|
||||
- Boolean variables are stored as integers, ~1~ for ~true~ and ~0~ for ~false~
|
||||
- Floating point variables should be by default ~double~ unless explicitly mentioned
|
||||
- integers used for counting should always be ~int64_t~
|
||||
|
||||
To facilitate the use in other languages than C, we will 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 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 [[./qmckl_context.html][=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.
|
||||
|
||||
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_set_= an =qmckl_get_=.
|
||||
|
||||
** Headers
|
||||
|
||||
A single =qmckl.h= header to be distributed by the library
|
||||
is built by concatenating some of the produced header files.
|
||||
To facilitate building the =qmckl.h= file, we separate types from
|
||||
function declarations in headers. Types should be defined in header
|
||||
files suffixed by =_type.h=, and functions in files suffixed by
|
||||
=_func.h=.
|
||||
As these files will be concatenated in a single file, they should
|
||||
not be guarded by ~#ifndef *_H~, and they should not include other
|
||||
produced headers.
|
||||
|
||||
Some particular types that are not exported need to be known by the
|
||||
context, and there are some functions to update instances of these
|
||||
types contained inside the context. For example, a
|
||||
~qmckl_numprec_struct~ is present in the context, and the function
|
||||
~qmckl_set_numprec_range~ takes a context as a parameter, and set a
|
||||
value in the ~qmckl_numprec_struct~ contained in the context.
|
||||
Because of these intricate dependencies, a private header is
|
||||
created, containing the ~qmckl_numprec_struct~. This header is
|
||||
included in the private header which defines the type of the
|
||||
context. Headers for private types are suffixed by =_private_type.h=
|
||||
and headers for private functions, =_private_func.h=.
|
||||
Fortran interfaces should also be written in the =*_f_func.f90= file,
|
||||
and the types definitions should be written in the =*_f_type.f90= file.
|
||||
|
||||
| File | Scope | Description |
|
||||
|--------------------+---------+------------------------------|
|
||||
| =*_type.h= | Public | Type definitions |
|
||||
| =*_func.h= | Public | Function definitions |
|
||||
| =*_private_type.h= | Private | Type definitions |
|
||||
| =*_private_func.h= | Private | Function definitions |
|
||||
| =*fh_type.f90= | Public | Fortran type definitions |
|
||||
| =*fh_func.f90= | Public | Fortran function definitions |
|
||||
|
||||
** 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).
|
||||
|
||||
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
|
||||
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.
|
||||
|
||||
# -*- mode: org -*-
|
||||
# vim: syntax=c
|
||||
|
1632
src/qmckl_ao.org
1632
src/qmckl_ao.org
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@ -1,80 +1,94 @@
|
||||
** Computation of distances
|
||||
#+TITLE: Inter-particle distances
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
#+INCLUDE: ../tools/lib.org
|
||||
|
||||
Function for the computation of distances between particles.
|
||||
Functions 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=
|
||||
* Headers :noexport:
|
||||
#+begin_src elisp :noexport :results none
|
||||
(org-babel-lob-ingest "../tools/lib.org")
|
||||
#+end_src
|
||||
|
||||
**** Headers :noexport:
|
||||
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
|
||||
#+begin_src c :comments link :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
MunitResult test_qmckl_distance() {
|
||||
MunitResult test_<<filename()>>() {
|
||||
qmckl_context context;
|
||||
context = qmckl_context_create();
|
||||
|
||||
#+END_SRC
|
||||
#+end_src
|
||||
|
||||
* Squared distance
|
||||
|
||||
*** Squared distance
|
||||
** ~qmckl_distance_sq~
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_distance_sq
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
**** =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:
|
||||
|
||||
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
|
||||
\]
|
||||
\[
|
||||
C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2
|
||||
\]
|
||||
|
||||
***** Arguments
|
||||
#+NAME: qmckl_distance_sq_args
|
||||
| qmckl_context | context | in | Global state |
|
||||
| char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed |
|
||||
| char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed |
|
||||
| int64_t | m | in | Number of points in the first set |
|
||||
| int64_t | n | in | Number of points in the second set |
|
||||
| double | A[][lda] | in | Array containing the $m \times 3$ matrix $A$ |
|
||||
| int64_t | lda | in | Leading dimension of array ~A~ |
|
||||
| double | B[][ldb] | in | Array containing the $n \times 3$ matrix $B$ |
|
||||
| int64_t | ldb | in | Leading dimension of array ~B~ |
|
||||
| double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ |
|
||||
| int64_t | ldc | in | 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 ~QMCKL_NULL_CONTEXT~
|
||||
- ~m > 0~
|
||||
- ~n > 0~
|
||||
- ~lda >= 3~ if ~transa == 'N'~
|
||||
- ~lda >= m~ if ~transa == 'T'~
|
||||
- ~ldb >= 3~ if ~transb == 'N'~
|
||||
- ~ldb >= n~ if ~transb == 'T'~
|
||||
- ~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
|
||||
|
||||
*** C header
|
||||
|
||||
- =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
|
||||
#+CALL: generate_c_header(table=qmckl_distance_sq_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
***** Performance
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
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,
|
||||
double* const C,
|
||||
const int64_t ldc );
|
||||
#+end_src
|
||||
|
||||
This function might be more efficient when =A= and =B= are
|
||||
transposed.
|
||||
|
||||
#+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
|
||||
|
||||
***** 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)
|
||||
*** Source
|
||||
#+begin_src f90 :tangle (eval f)
|
||||
integer function qmckl_distance_sq_f(context, transa, transb, m, n, &
|
||||
A, LDA, B, LDB, C, LDC) &
|
||||
result(info)
|
||||
use qmckl
|
||||
implicit none
|
||||
integer*8 , intent(in) :: context
|
||||
integer(qmckl_context) , intent(in) :: context
|
||||
character , intent(in) :: transa, transb
|
||||
integer*8 , intent(in) :: m, n
|
||||
integer*8 , intent(in) :: lda
|
||||
@ -88,20 +102,20 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L
|
||||
real*8 :: x, y, z
|
||||
integer :: transab
|
||||
|
||||
info = 0
|
||||
info = QMCKL_SUCCESS
|
||||
|
||||
if (context == 0_8) then
|
||||
info = -1
|
||||
if (context == QMCKL_NULL_CONTEXT) then
|
||||
info = QMCKL_INVALID_CONTEXT
|
||||
return
|
||||
endif
|
||||
|
||||
if (m <= 0_8) then
|
||||
info = -2
|
||||
info = QMCKL_INVALID_ARG_4
|
||||
return
|
||||
endif
|
||||
|
||||
if (n <= 0_8) then
|
||||
info = -3
|
||||
info = QMCKL_INVALID_ARG_5
|
||||
return
|
||||
endif
|
||||
|
||||
@ -122,33 +136,33 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L
|
||||
endif
|
||||
|
||||
if (transab < 0) then
|
||||
info = -4
|
||||
info = QMCKL_INVALID_ARG_1
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,1) == 0 .and. LDA < 3) then
|
||||
info = -5
|
||||
info = QMCKL_INVALID_ARG_7
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,1) == 1 .and. LDA < m) then
|
||||
info = -6
|
||||
info = QMCKL_INVALID_ARG_7
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,2) == 0 .and. LDA < 3) then
|
||||
info = -6
|
||||
info = QMCKL_INVALID_ARG_7
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,2) == 2 .and. LDA < m) then
|
||||
info = -7
|
||||
info = QMCKL_INVALID_ARG_7
|
||||
return
|
||||
endif
|
||||
|
||||
|
||||
select case (transab)
|
||||
|
||||
|
||||
case(0)
|
||||
|
||||
do j=1,n
|
||||
@ -194,56 +208,81 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L
|
||||
end do
|
||||
|
||||
end select
|
||||
|
||||
|
||||
end function qmckl_distance_sq_f
|
||||
#+END_SRC
|
||||
#+end_src
|
||||
|
||||
*** Performance
|
||||
|
||||
***** 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
|
||||
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)
|
||||
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)
|
||||
This function might be more efficient when ~A~ and ~B~ are
|
||||
transposed.
|
||||
|
||||
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
|
||||
** C interface :noexport:
|
||||
|
||||
#+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)
|
||||
#+CALL: generate_c_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_distance_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 , intent(in) , value :: transa
|
||||
character , intent(in) , value :: transb
|
||||
integer (c_int64_t) , intent(in) , value :: m
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: A(lda,*)
|
||||
integer (c_int64_t) , intent(in) , value :: lda
|
||||
real (c_double ) , intent(in) :: B(ldb,*)
|
||||
integer (c_int64_t) , intent(in) , value :: ldb
|
||||
real (c_double ) , intent(out) :: C(ldc,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldc
|
||||
|
||||
integer(c_int32_t), external :: qmckl_distance_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
|
||||
|
||||
#+CALL: generate_f_interface(table=qmckl_distance_sq_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_distance_sq &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
character (c_char) , intent(in) , value :: transa, 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
|
||||
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 :tangle test_qmckl_distance_f.f90
|
||||
integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
character , intent(in) , value :: transa
|
||||
character , intent(in) , value :: transb
|
||||
integer (c_int64_t) , intent(in) , value :: m
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: A(lda,*)
|
||||
integer (c_int64_t) , intent(in) , value :: lda
|
||||
real (c_double ) , intent(in) :: B(ldb,*)
|
||||
integer (c_int64_t) , intent(in) , value :: ldb
|
||||
real (c_double ) , intent(out) :: C(ldc,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldc
|
||||
|
||||
end function qmckl_distance_sq
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
*** Test :noexport:
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
integer(qmckl_exit_code) function test_qmckl_distance_sq(context) bind(C)
|
||||
use qmckl
|
||||
implicit none
|
||||
integer(c_int64_t), intent(in), value :: context
|
||||
integer(qmckl_context), intent(in), value :: context
|
||||
|
||||
double precision, allocatable :: A(:,:), B(:,:), C(:,:)
|
||||
integer*8 :: m, n, LDA, LDB, LDC
|
||||
@ -269,13 +308,19 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_distance_sq = qmckl_distance_sq(context, 'X', 't', 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)
|
||||
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)
|
||||
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
|
||||
@ -288,8 +333,10 @@ 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)
|
||||
|
||||
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
|
||||
@ -303,7 +350,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_distance_sq = qmckl_distance_sq(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC)
|
||||
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
|
||||
@ -317,7 +366,9 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_distance_sq = qmckl_distance_sq(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC)
|
||||
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
|
||||
@ -330,27 +381,405 @@ 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 = 0
|
||||
|
||||
|
||||
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 (eval c_test)
|
||||
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
|
||||
* Distance
|
||||
|
||||
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
|
||||
** ~qmckl_distance~
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_distance
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
~qmckl_distance~ computes the matrix of the distances between all
|
||||
pairs of points in two sets, one point within each set:
|
||||
|
||||
\[
|
||||
C_{ij} = \sqrt{\sum_{k=1}^3 (A_{k,i}-B_{k,j})^2}
|
||||
\]
|
||||
|
||||
#+NAME: qmckl_distance_args
|
||||
| qmckl_context | context | in | Global state |
|
||||
| char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed |
|
||||
| char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed |
|
||||
| int64_t | m | in | Number of points in the first set |
|
||||
| int64_t | n | in | Number of points in the second set |
|
||||
| double | A[][lda] | in | Array containing the $m \times 3$ matrix $A$ |
|
||||
| int64_t | lda | in | Leading dimension of array ~A~ |
|
||||
| double | B[][ldb] | in | Array containing the $n \times 3$ matrix $B$ |
|
||||
| int64_t | ldb | in | Leading dimension of array ~B~ |
|
||||
| double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ |
|
||||
| int64_t | ldc | in | Leading dimension of array ~C~ |
|
||||
|
||||
*** Requirements
|
||||
|
||||
- ~context~ is not ~QMCKL_NULL_CONTEXT~
|
||||
- ~m > 0~
|
||||
- ~n > 0~
|
||||
- ~lda >= 3~ if ~transa == 'N'~
|
||||
- ~lda >= m~ if ~transa == 'T'~
|
||||
- ~ldb >= 3~ if ~transb == 'N'~
|
||||
- ~ldb >= n~ if ~transb == 'T'~
|
||||
- ~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
|
||||
|
||||
*** C header
|
||||
|
||||
#+CALL: generate_c_header(table=qmckl_distance_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_distance (
|
||||
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,
|
||||
double* const C,
|
||||
const int64_t ldc );
|
||||
#+end_src
|
||||
|
||||
*** Source
|
||||
#+begin_src f90 :tangle (eval f)
|
||||
integer function qmckl_distance_f(context, transa, transb, m, n, &
|
||||
A, LDA, B, LDB, C, LDC) &
|
||||
result(info)
|
||||
use qmckl
|
||||
implicit none
|
||||
integer(qmckl_context) , intent(in) :: context
|
||||
character , intent(in) :: transa, transb
|
||||
integer*8 , intent(in) :: m, n
|
||||
integer*8 , intent(in) :: lda
|
||||
real*8 , intent(in) :: A(lda,*)
|
||||
integer*8 , intent(in) :: ldb
|
||||
real*8 , intent(in) :: B(ldb,*)
|
||||
integer*8 , intent(in) :: ldc
|
||||
real*8 , intent(out) :: C(ldc,*)
|
||||
|
||||
integer*8 :: i,j
|
||||
real*8 :: x, y, z
|
||||
integer :: transab
|
||||
|
||||
info = QMCKL_SUCCESS
|
||||
|
||||
if (context == QMCKL_NULL_CONTEXT) then
|
||||
info = QMCKL_INVALID_CONTEXT
|
||||
return
|
||||
endif
|
||||
|
||||
if (m <= 0_8) then
|
||||
info = QMCKL_INVALID_ARG_4
|
||||
return
|
||||
endif
|
||||
|
||||
if (n <= 0_8) then
|
||||
info = QMCKL_INVALID_ARG_5
|
||||
return
|
||||
endif
|
||||
|
||||
if (transa == 'N' .or. transa == 'n') then
|
||||
transab = 0
|
||||
else if (transa == 'T' .or. transa == 't') then
|
||||
transab = 1
|
||||
else
|
||||
transab = -100
|
||||
endif
|
||||
|
||||
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 = QMCKL_INVALID_ARG_1
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,1) == 0 .and. LDA < 3) then
|
||||
info = QMCKL_INVALID_ARG_7
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,1) == 1 .and. LDA < m) then
|
||||
info = QMCKL_INVALID_ARG_7
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,2) == 0 .and. LDA < 3) then
|
||||
info = QMCKL_INVALID_ARG_7
|
||||
return
|
||||
endif
|
||||
|
||||
if (iand(transab,2) == 2 .and. LDA < m) then
|
||||
info = QMCKL_INVALID_ARG_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
|
||||
C(:,j) = dsqrt(C(:,j))
|
||||
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
|
||||
C(:,j) = dsqrt(C(:,j))
|
||||
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
|
||||
C(:,j) = dsqrt(C(:,j))
|
||||
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
|
||||
C(:,j) = dsqrt(C(:,j))
|
||||
end do
|
||||
|
||||
end select
|
||||
|
||||
end function qmckl_distance_f
|
||||
#+end_src
|
||||
|
||||
*** Performance
|
||||
|
||||
This function might be more efficient when ~A~ and ~B~ are
|
||||
transposed.
|
||||
|
||||
** C interface :noexport:
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_distance_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_distance &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
|
||||
bind(C) result(info)
|
||||
|
||||
use, intrinsic :: iso_c_binding
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
character , intent(in) , value :: transa
|
||||
character , intent(in) , value :: transb
|
||||
integer (c_int64_t) , intent(in) , value :: m
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: A(lda,*)
|
||||
integer (c_int64_t) , intent(in) , value :: lda
|
||||
real (c_double ) , intent(in) :: B(ldb,*)
|
||||
integer (c_int64_t) , intent(in) , value :: ldb
|
||||
real (c_double ) , intent(out) :: C(ldc,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldc
|
||||
|
||||
integer(c_int32_t), external :: qmckl_distance_f
|
||||
info = qmckl_distance_f &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc)
|
||||
|
||||
end function qmckl_distance
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_f_interface(table=qmckl_distance_args,rettyp=get_value("FRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function qmckl_distance &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (c_int64_t) , intent(in) , value :: context
|
||||
character , intent(in) , value :: transa
|
||||
character , intent(in) , value :: transb
|
||||
integer (c_int64_t) , intent(in) , value :: m
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: A(lda,*)
|
||||
integer (c_int64_t) , intent(in) , value :: lda
|
||||
real (c_double ) , intent(in) :: B(ldb,*)
|
||||
integer (c_int64_t) , intent(in) , value :: ldb
|
||||
real (c_double ) , intent(out) :: C(ldc,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldc
|
||||
|
||||
end function qmckl_distance
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
*** Test :noexport:
|
||||
#+begin_src f90 :tangle (eval f_test)
|
||||
integer(qmckl_exit_code) function test_qmckl_dist(context) bind(C)
|
||||
use qmckl
|
||||
implicit none
|
||||
integer(qmckl_context), intent(in), value :: context
|
||||
|
||||
double precision, allocatable :: A(:,:), B(:,:), C(:,:)
|
||||
integer*8 :: m, n, LDA, LDB, LDC
|
||||
double precision :: x
|
||||
integer*8 :: i,j
|
||||
|
||||
m = 5
|
||||
n = 6
|
||||
LDA = m
|
||||
LDB = n
|
||||
LDC = 5
|
||||
|
||||
allocate( A(LDA,m), B(LDB,n), C(LDC,n) )
|
||||
|
||||
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_dist = &
|
||||
qmckl_distance(context, 'X', 't', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist == 0) return
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 't', 'X', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist == 0) return
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'T', 't', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
|
||||
test_qmckl_dist = -1
|
||||
|
||||
do j=1,n
|
||||
do i=1,m
|
||||
x = dsqrt((A(i,1)-B(j,1))**2 + &
|
||||
(A(i,2)-B(j,2))**2 + &
|
||||
(A(i,3)-B(j,3))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'n', 'T', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
|
||||
test_qmckl_dist = -1
|
||||
|
||||
do j=1,n
|
||||
do i=1,m
|
||||
x = dsqrt((A(1,i)-B(j,1))**2 + &
|
||||
(A(2,i)-B(j,2))**2 + &
|
||||
(A(3,i)-B(j,3))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'T', 'n', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
|
||||
test_qmckl_dist = -1
|
||||
|
||||
do j=1,n
|
||||
do i=1,m
|
||||
x = dsqrt((A(i,1)-B(1,j))**2 + &
|
||||
(A(i,2)-B(2,j))**2 + &
|
||||
(A(i,3)-B(3,j))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_dist = &
|
||||
qmckl_distance(context, 'n', 'N', m, n, A, LDA, B, LDB, C, LDC)
|
||||
|
||||
if (test_qmckl_dist /= 0) return
|
||||
|
||||
test_qmckl_dist = -1
|
||||
|
||||
do j=1,n
|
||||
do i=1,m
|
||||
x = dsqrt((A(1,i)-B(1,j))**2 + &
|
||||
(A(2,i)-B(2,j))**2 + &
|
||||
(A(3,i)-B(3,j))**2)
|
||||
if ( dabs(1.d0 - C(i,j)/x) > 1.d-14 ) return
|
||||
end do
|
||||
end do
|
||||
|
||||
test_qmckl_dist = 0
|
||||
|
||||
deallocate(A,B,C)
|
||||
end function test_qmckl_dist
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
int test_qmckl_dist(qmckl_context context);
|
||||
munit_assert_int(0, ==, test_qmckl_dist(context));
|
||||
#+end_src
|
||||
* End of files :noexport:
|
||||
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
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
|
||||
|
655
src/qmckl_electron.org
Normal file
655
src/qmckl_electron.org
Normal file
@ -0,0 +1,655 @@
|
||||
#+TITLE: Electrons
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
#+INCLUDE: ../tools/lib.org
|
||||
|
||||
In conventional QMC simulations, up-spin and down-spin electrons are
|
||||
different. The ~electron~ data structure contains the number of
|
||||
up-spin and down-spin electrons, and the electron coordinates.
|
||||
|
||||
* Headers :noexport:
|
||||
#+begin_src elisp :noexport :results none
|
||||
(org-babel-lob-ingest "../tools/lib.org")
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#ifndef QMCKL_ELECTRON_HPT
|
||||
#define QMCKL_ELECTRON_HPT
|
||||
#include <stdbool.h>
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
MunitResult test_<<filename()>>() {
|
||||
qmckl_context context;
|
||||
context = qmckl_context_create();
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdbool.h>
|
||||
#include <assert.h>
|
||||
#include <math.h>
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "qmckl_error_type.h"
|
||||
#include "qmckl_context_type.h"
|
||||
#include "qmckl_context_private_type.h"
|
||||
#include "qmckl_memory_private_type.h"
|
||||
|
||||
#include "qmckl_error_func.h"
|
||||
#include "qmckl_memory_private_func.h"
|
||||
#include "qmckl_memory_func.h"
|
||||
#include "qmckl_context_func.h"
|
||||
#include "qmckl_electron_private_func.h"
|
||||
#+end_src
|
||||
|
||||
* Context
|
||||
|
||||
The following data stored in the context:
|
||||
|
||||
| ~uninitialized~ | int32_t | Keeps bit set for uninitialized data |
|
||||
| ~num~ | int64_t | Total number of electrons |
|
||||
| ~up_num~ | int64_t | Number of up-spin electrons |
|
||||
| ~down_num~ | int64_t | Number of down-spin electrons |
|
||||
| ~walk_num~ | int64_t | Number of walkers |
|
||||
| ~provided~ | bool | If true, ~electron~ is valid |
|
||||
| ~coord_new~ | double[walk_num][3][num] | New set of electron coordinates |
|
||||
| ~coord_old~ | double[walk_num][3][num] | Old set of electron coordinates |
|
||||
| ~coord_new_date~ | uint64_t | Last modification date of the coordinates |
|
||||
| ~ee_distance~ | double[walk_num][num][num] | Electron-electron distances |
|
||||
| ~ee_distance_date~ | uint64_t | Last modification date of the electron-electron distances |
|
||||
|
||||
** Data structure
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_type)
|
||||
typedef struct qmckl_electron_struct {
|
||||
int64_t num;
|
||||
int64_t up_num;
|
||||
int64_t down_num;
|
||||
int64_t walk_num;
|
||||
int64_t coord_new_date;
|
||||
int64_t ee_distance_date;
|
||||
double* coord_new;
|
||||
double* coord_old;
|
||||
double* ee_distance;
|
||||
int32_t uninitialized;
|
||||
bool provided;
|
||||
} qmckl_electron_struct;
|
||||
#+end_src
|
||||
|
||||
The ~uninitialized~ integer contains one bit set to one for each
|
||||
initialization function which has not bee called. It becomes equal
|
||||
to zero after all initialization functions have been called. The
|
||||
struct is then initialized and ~provided == true~.
|
||||
|
||||
** Access functions
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func) :exports none
|
||||
int64_t qmckl_get_electron_num (const qmckl_context context);
|
||||
int64_t qmckl_get_electron_up_num (const qmckl_context context);
|
||||
int64_t qmckl_get_electron_down_num (const qmckl_context context);
|
||||
int64_t qmckl_get_electron_walk_num (const qmckl_context context);
|
||||
double* qmckl_get_electron_coord_new (const qmckl_context context);
|
||||
double* qmckl_get_electron_coord_old (const qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
When all the data relative to electrons have been set, the
|
||||
following function returns ~true~.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func)
|
||||
bool qmckl_electron_provided (const qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
#+NAME:post
|
||||
#+begin_src c :exports none
|
||||
if ( (ctx->electron.uninitialized & mask) != 0) {
|
||||
return NULL;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
int64_t qmckl_get_electron_num (const qmckl_context context) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return (char) 0;
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1;
|
||||
|
||||
if ( (ctx->electron.uninitialized & mask) != 0) {
|
||||
return (int64_t) 0;
|
||||
}
|
||||
|
||||
assert (ctx->electron.num > (int64_t) 0);
|
||||
return ctx->electron.num;
|
||||
}
|
||||
|
||||
|
||||
int64_t qmckl_get_electron_up_num (const qmckl_context context) {
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return (int64_t) 0;
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 1;
|
||||
|
||||
if ( (ctx->electron.uninitialized & mask) != 0) {
|
||||
return (int64_t) 0;
|
||||
}
|
||||
|
||||
assert (ctx->electron.up_num > (int64_t) 0);
|
||||
return ctx->electron.up_num;
|
||||
}
|
||||
|
||||
|
||||
int64_t qmckl_get_electron_down_num (const qmckl_context context) {
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return (int64_t) 0;
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 2;
|
||||
|
||||
if ( (ctx->electron.uninitialized & mask) != 0) {
|
||||
return (int64_t) 0;
|
||||
}
|
||||
|
||||
assert (ctx->electron.down_num >= (int64_t) 0);
|
||||
return ctx->electron.down_num;
|
||||
}
|
||||
|
||||
|
||||
int64_t qmckl_get_electron_walk_num (const qmckl_context context) {
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return (int64_t) 0;
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
int32_t mask = 1 << 3;
|
||||
|
||||
if ( (ctx->electron.uninitialized & mask) != 0) {
|
||||
return (int64_t) 0;
|
||||
}
|
||||
|
||||
assert (ctx->electron.walk_num > (int64_t) 0);
|
||||
return ctx->electron.walk_num;
|
||||
}
|
||||
|
||||
|
||||
|
||||
bool qmckl_electron_provided(const qmckl_context context) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return false;
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
return ctx->electron.provided;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
** Initialization functions
|
||||
|
||||
To set the data relative to the electrons in the context, the
|
||||
following functions need to be called. When the data structure is
|
||||
initialized, the ~coord_new~ and ~coord_old~ arrays are both allocated.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func)
|
||||
qmckl_exit_code qmckl_set_electron_num (qmckl_context context, const int64_t up_num, const int64_t down_num);
|
||||
qmckl_exit_code qmckl_set_electron_walk_num (qmckl_context context, const int64_t walk_num);
|
||||
qmckl_exit_code qmckl_set_electron_coord (qmckl_context context, const double* coord);
|
||||
#+end_src
|
||||
|
||||
#+NAME:pre2
|
||||
#+begin_src c :exports none
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
#+end_src
|
||||
|
||||
#+NAME:post2
|
||||
#+begin_src c :exports none
|
||||
ctx->electron.uninitialized &= ~mask;
|
||||
ctx->electron.provided = (ctx->electron.uninitialized == 0);
|
||||
|
||||
if (ctx->electron.provided) {
|
||||
if (ctx->electron.coord_new != NULL) {
|
||||
qmckl_free(context, ctx->electron.coord_new);
|
||||
ctx->electron.coord_new = NULL;
|
||||
}
|
||||
if (ctx->electron.coord_old != NULL) {
|
||||
qmckl_free(context, ctx->electron.coord_old);
|
||||
ctx->electron.coord_old = NULL;
|
||||
}
|
||||
|
||||
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
||||
mem_info.size = ctx->electron.num * ctx->electron.walk_num * 3 * sizeof(double);
|
||||
|
||||
double* coord_new = (double*) qmckl_malloc(context, mem_info);
|
||||
if (coord_new == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"qmckl_set_electron_num",
|
||||
NULL);
|
||||
}
|
||||
ctx->electron.coord_new = coord_new;
|
||||
|
||||
double* coord_old = (double*) qmckl_malloc(context, mem_info);
|
||||
if (coord_old == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"qmckl_set_electron_num",
|
||||
NULL);
|
||||
}
|
||||
ctx->electron.coord_old = coord_old;
|
||||
|
||||
}
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
#+end_src
|
||||
|
||||
To set the number of electrons, we give the number of up-spin and
|
||||
down-spin electrons to the context and we set the number of walkers.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_set_electron_num(qmckl_context context,
|
||||
const int64_t up_num,
|
||||
const int64_t down_num) {
|
||||
<<pre2>>
|
||||
|
||||
if (up_num <= 0) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_set_electron_num",
|
||||
"up_num <= 0");
|
||||
}
|
||||
|
||||
if (down_num <= 0) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_3,
|
||||
"qmckl_set_electron_num",
|
||||
"down_num <= 0");
|
||||
}
|
||||
|
||||
int32_t mask = 1;
|
||||
|
||||
ctx->electron.up_num = up_num;
|
||||
ctx->electron.down_num = down_num;
|
||||
ctx->electron.num = up_num + down_num;
|
||||
|
||||
<<post2>>
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_set_electron_walk_num(qmckl_context context, const int64_t walk_num) {
|
||||
<<pre2>>
|
||||
|
||||
if (walk_num <= 0) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_set_electron_walk_num",
|
||||
"walk_num <= 0");
|
||||
}
|
||||
|
||||
int32_t mask = 2;
|
||||
ctx->electron.walk_num = walk_num;
|
||||
|
||||
<<post2>>
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
The following function sets the electron coordinates of all the
|
||||
walkers. When this is done, the pointers to the old and new sets
|
||||
of coordinates are swapped, and the new coordinates are
|
||||
overwritten. This can be done only when the data relative to
|
||||
electrons have been set.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_set_electron_coord(qmckl_context context, const double* coord) {
|
||||
<<pre2>>
|
||||
|
||||
const int64_t num = qmckl_get_electron_num(context);
|
||||
if (num == 0L) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_FAILURE,
|
||||
"qmckl_set_electron_coord",
|
||||
"num is not set");
|
||||
}
|
||||
|
||||
const int64_t walk_num = qmckl_get_electron_walk_num(context);
|
||||
if (walk_num == 0L) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_FAILURE,
|
||||
"qmckl_set_electron_coord",
|
||||
"walk_num is not set");
|
||||
}
|
||||
|
||||
/* If num and walk_num are set, the arrays should be allocated */
|
||||
assert (ctx->electron.coord_old != NULL);
|
||||
assert (ctx->electron.coord_new != NULL);
|
||||
|
||||
/* Increment the date of the context */
|
||||
ctx->date += 1UL;
|
||||
|
||||
/* Swap pointers */
|
||||
double * swap;
|
||||
swap = ctx->electron.coord_old;
|
||||
ctx->electron.coord_old = ctx->electron.coord_new;
|
||||
ctx->electron.coord_new = swap;
|
||||
|
||||
memcpy(ctx->electron.coord_new, coord, walk_num * num * 3 * sizeof(double));
|
||||
ctx->electron.coord_new_date = ctx->date;
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
|
||||
}
|
||||
#+end_src
|
||||
|
||||
** Test
|
||||
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
/* Reference input data */
|
||||
|
||||
#define up_num ((int64_t) 3)
|
||||
#define down_num ((int64_t) 2)
|
||||
#define walk_num ((int64_t) 2)
|
||||
#define num (up_num+down_num)
|
||||
|
||||
double coord[walk_num*3*num] =
|
||||
{ 7.303633091022677881e+00, 1.375868694453235719e+01, 1.167371490471771217e-01,
|
||||
4.547755371567960836e+00, 3.245907105524011182e+00, 2.410764357550297110e-01,
|
||||
5.932816068137344523e+00, 1.491671465549257469e+01, 3.825374039119375236e-01,
|
||||
7.347336142660052083e+00, 1.341946976062362129e+00, 1.648917914228352322e+00,
|
||||
5.735221530102248444e+00, 1.064667491680036271e+01, 4.227201772236627297e-01,
|
||||
8.099550978782254163e+00, 6.861498941099086757e+00, 4.015884841159429036e-02,
|
||||
1.014757367558326173e+01, 5.219335322173662917e+00, 5.037004126899931322e-02,
|
||||
1.484094322159507051e+01, 9.777903829455864226e+00, 5.243007994024882767e-02,
|
||||
9.081723054990456845e+00, 5.499568496038920173e+00, 2.910446438899221347e-02,
|
||||
2.583154239492383653e+00, 1.442282811294904432e+00, 6.387191629878670451e-02 };
|
||||
|
||||
/* --- */
|
||||
|
||||
qmckl_exit_code rc;
|
||||
|
||||
munit_assert(!qmckl_electron_provided(context));
|
||||
|
||||
rc = qmckl_set_electron_num (context, up_num, down_num);
|
||||
munit_assert_int64(rc, ==, QMCKL_SUCCESS);
|
||||
munit_assert(!qmckl_electron_provided(context));
|
||||
|
||||
rc = qmckl_set_electron_walk_num (context, walk_num);
|
||||
munit_assert_int64(rc, ==, QMCKL_SUCCESS);
|
||||
munit_assert(qmckl_electron_provided(context));
|
||||
|
||||
rc = qmckl_set_electron_coord (context, coord);
|
||||
munit_assert_int64(rc, ==, QMCKL_SUCCESS);
|
||||
|
||||
#+end_src
|
||||
|
||||
* Computation
|
||||
|
||||
The computed data is stored in the context so that it can be reused
|
||||
by different kernels. To ensure that the data is valid, for each
|
||||
computed data the date of the context is stored when it is computed.
|
||||
To know if some data needs to be recomputed, we check if the date of
|
||||
the dependencies are more recent than the date of the data to
|
||||
compute. If it is the case, then the data is recomputed and the
|
||||
current date is stored.
|
||||
|
||||
** Electron-electron distances
|
||||
|
||||
*** Get
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
||||
qmckl_exit_code qmckl_get_electron_ee_distance(qmckl_context context, double* distance);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_get_electron_ee_distance(qmckl_context context, double* distance)
|
||||
{
|
||||
/* Check input parameters */
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return (char) 0;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc = qmckl_provide_ee_distance(context);
|
||||
if (rc != QMCKL_SUCCESS) return rc;
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
size_t sze = ctx->electron.num * ctx->electron.num * ctx->electron.walk_num;
|
||||
memcpy(distance, ctx->electron.ee_distance, sze * sizeof(double));
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
*** Provide :noexport:
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_provide_ee_distance(qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_provide_ee_distance(qmckl_context context)
|
||||
{
|
||||
/* Check input parameters */
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return (char) 0;
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL);
|
||||
|
||||
|
||||
/* Compute if necessary */
|
||||
if (ctx->electron.coord_new_date > ctx->electron.ee_distance_date) {
|
||||
|
||||
fprintf(stderr, "%10ld: provide ee_distance", ctx->date);
|
||||
/* Allocate array */
|
||||
if (ctx->electron.ee_distance == NULL) {
|
||||
|
||||
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
||||
mem_info.size = ctx->electron.num * ctx->electron.num *
|
||||
ctx->electron.walk_num * sizeof(double);
|
||||
double* ee_distance = (double*) qmckl_malloc(context, mem_info);
|
||||
|
||||
if (ee_distance == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"qmckl_ee_distance",
|
||||
NULL);
|
||||
}
|
||||
ctx->electron.ee_distance = ee_distance;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc =
|
||||
qmckl_compute_ee_distance(context,
|
||||
ctx->electron.num,
|
||||
ctx->electron.walk_num,
|
||||
ctx->electron.coord_new,
|
||||
ctx->electron.ee_distance);
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
||||
ctx->electron.ee_distance_date = ctx->date;
|
||||
}
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
*** Compute
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_compute_ee_distance
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
#+NAME: qmckl_ee_distance_args
|
||||
| qmckl_context | context | in | Global state |
|
||||
| int64_t | elec_num | in | Number of electrons |
|
||||
| int64_t | walk_num | in | Number of walkers |
|
||||
| double | coord[walk_num][3][elec_num] | in | Electron coordinates |
|
||||
| double | ee_distance[walk_num][elec_num][elec_num] | out | Electron-electron distances |
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
||||
integer function qmckl_compute_ee_distance_f(context, elec_num, walk_num, coord, ee_distance) &
|
||||
result(info)
|
||||
use qmckl
|
||||
implicit none
|
||||
integer(qmckl_context), intent(in) :: context
|
||||
integer*8 , intent(in) :: elec_num
|
||||
integer*8 , intent(in) :: walk_num
|
||||
double precision , intent(in) :: coord(elec_num,3,walk_num)
|
||||
double precision , intent(out) :: ee_distance(elec_num,elec_num,walk_num)
|
||||
|
||||
integer*8 :: k
|
||||
|
||||
info = QMCKL_SUCCESS
|
||||
|
||||
if (context == QMCKL_NULL_CONTEXT) then
|
||||
info = QMCKL_INVALID_CONTEXT
|
||||
return
|
||||
endif
|
||||
|
||||
if (elec_num <= 0) then
|
||||
info = QMCKL_INVALID_ARG_2
|
||||
return
|
||||
endif
|
||||
|
||||
if (walk_num <= 0) then
|
||||
info = QMCKL_INVALID_ARG_3
|
||||
return
|
||||
endif
|
||||
|
||||
!$OMP PARALLEL DO DEFAULT(NONE) &
|
||||
!$OMP SHARED(elec_num, walk_num, coord, ee_distance)
|
||||
!$OMP PRIVATE(k)
|
||||
do k=1,walk_num
|
||||
info = qmckl_distance(context, 'T', 'T', elec_num, elec_num, &
|
||||
coord(1,1,k), elec_num, &
|
||||
coord(1,1,k), elec_num, &
|
||||
ee_distance(1,1,k), elec_num)
|
||||
end do
|
||||
!$OMP END PARALLEL DO
|
||||
|
||||
end function qmckl_compute_ee_distance_f
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval h_private_func) :comments org :exports none
|
||||
qmckl_exit_code qmckl_compute_ee_distance (
|
||||
const qmckl_context context,
|
||||
const int64_t elec_num,
|
||||
const int64_t walk_num,
|
||||
const double* coord,
|
||||
double* const ee_distance );
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_ee_distance_args,rettyp=get_value("CRetType"),fname=get_value("Name"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_compute_ee_distance &
|
||||
(context, elec_num, walk_num, coord, ee_distance) &
|
||||
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 :: elec_num
|
||||
integer (c_int64_t) , intent(in) , value :: walk_num
|
||||
real (c_double ) , intent(in) :: coord(elec_num,3,walk_num)
|
||||
real (c_double ) , intent(out) :: ee_distance(elec_num,elec_num,walk_num)
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_ee_distance_f
|
||||
info = qmckl_compute_ee_distance_f &
|
||||
(context, elec_num, walk_num, coord, ee_distance)
|
||||
|
||||
end function qmckl_compute_ee_distance
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
/* Reference input data */
|
||||
|
||||
munit_assert(qmckl_electron_provided(context));
|
||||
|
||||
double distance[walk_num*num*num];
|
||||
rc = qmckl_get_electron_ee_distance(context, distance);
|
||||
rc = qmckl_get_electron_ee_distance(context, distance);
|
||||
munit_assert_double(distance[0], ==, 0.);
|
||||
munit_assert_double(distance[1], ==, distance[num]);
|
||||
munit_assert_double_equal(distance[1], 8.6114953086801, 12);
|
||||
|
||||
#+end_src
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
if (qmckl_context_destroy(context) != QMCKL_SUCCESS)
|
||||
return QMCKL_FAILURE;
|
||||
return MUNIT_OK;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
**✸ Compute file names
|
||||
#+begin_src emacs-lisp
|
||||
; The following is required to compute the file names
|
||||
|
||||
(setq pwd (file-name-directory buffer-file-name))
|
||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||||
(setq f (concat pwd name "_f.f90"))
|
||||
(setq fh (concat pwd name "_fh.f90"))
|
||||
(setq c (concat pwd name ".c"))
|
||||
(setq h (concat name ".h"))
|
||||
(setq h_private (concat name "_private.h"))
|
||||
(setq c_test (concat pwd "test_" name ".c"))
|
||||
(setq f_test (concat pwd "test_" name "_f.f90"))
|
||||
|
||||
; Minted
|
||||
(require 'ox-latex)
|
||||
(setq org-latex-listings 'minted)
|
||||
(add-to-list 'org-latex-packages-alist '("" "listings"))
|
||||
(add-to-list 'org-latex-packages-alist '("" "color"))
|
||||
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
| | color |
|
||||
| | listings |
|
||||
|
||||
|
||||
# -*- mode: org -*-
|
||||
# vim: syntax=c
|
||||
|
||||
|
362
src/qmckl_error.org
Normal file
362
src/qmckl_error.org
Normal file
@ -0,0 +1,362 @@
|
||||
#+TITLE: Error handling
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
#+INCLUDE: ../tools/lib.org
|
||||
|
||||
* Headers :noexport:
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#ifndef QMCKL_ERROR_HPT
|
||||
#define QMCKL_ERROR_HPT
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
#include <pthread.h>
|
||||
#include <errno.h>
|
||||
|
||||
#include "qmckl_error_type.h"
|
||||
#include "qmckl_context_private_type.h"
|
||||
#include "qmckl_context_type.h"
|
||||
|
||||
#include "qmckl_context_func.h"
|
||||
#include "qmckl_error_func.h"
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
MunitResult test_<<filename()>>() {
|
||||
#+end_src
|
||||
|
||||
#+end_src
|
||||
|
||||
*
|
||||
:PROPERTIES:
|
||||
:UNNUMBERED: t
|
||||
:END:
|
||||
|
||||
The library should never make the calling programs abort, nor
|
||||
perform any input/output operations. This decision has to be taken
|
||||
by the developer of the code calling the library.
|
||||
|
||||
All the functions return with an exit code, defined as
|
||||
#+NAME: type-exit-code
|
||||
#+begin_src c :comments org :tangle (eval h_type)
|
||||
typedef int32_t qmckl_exit_code;
|
||||
#+end_src
|
||||
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval fh_type) :exports none
|
||||
integer , parameter :: qmckl_exit_code = c_int32_t
|
||||
#+end_src
|
||||
|
||||
The exit code returns the completion status of the function to the
|
||||
calling program. When a function call completed successfully,
|
||||
~QMCKL_SUCCESS~ is returned. If one of the functions of
|
||||
the library fails to complete the requested task, an appropriate
|
||||
error code is returned to the program.
|
||||
|
||||
Here is the complete list of exit codes.
|
||||
|
||||
#+NAME: table-exit-codes
|
||||
| Macro | Code | Description |
|
||||
|-----------------------------+------+------------------------|
|
||||
| ~QMCKL_SUCCESS~ | 0 | 'Success' |
|
||||
| ~QMCKL_INVALID_ARG_1~ | 1 | 'Invalid argument 1' |
|
||||
| ~QMCKL_INVALID_ARG_2~ | 2 | 'Invalid argument 2' |
|
||||
| ~QMCKL_INVALID_ARG_3~ | 3 | 'Invalid argument 3' |
|
||||
| ~QMCKL_INVALID_ARG_4~ | 4 | 'Invalid argument 4' |
|
||||
| ~QMCKL_INVALID_ARG_5~ | 5 | 'Invalid argument 5' |
|
||||
| ~QMCKL_INVALID_ARG_6~ | 6 | 'Invalid argument 6' |
|
||||
| ~QMCKL_INVALID_ARG_7~ | 7 | 'Invalid argument 7' |
|
||||
| ~QMCKL_INVALID_ARG_8~ | 8 | 'Invalid argument 8' |
|
||||
| ~QMCKL_INVALID_ARG_9~ | 9 | 'Invalid argument 9' |
|
||||
| ~QMCKL_INVALID_ARG_10~ | 10 | 'Invalid argument 10' |
|
||||
| ~QMCKL_FAILURE~ | 101 | 'Failure' |
|
||||
| ~QMCKL_ERRNO~ | 102 | strerror(errno) |
|
||||
| ~QMCKL_INVALID_CONTEXT~ | 103 | 'Invalid context' |
|
||||
| ~QMCKL_ALLOCATION_FAILED~ | 104 | 'Allocation failed' |
|
||||
| ~QMCKL_DEALLOCATION_FAILED~ | 105 | 'De-allocation failed' |
|
||||
| ~QMCKL_INVALID_EXIT_CODE~ | 106 | 'Invalid exit code' |
|
||||
|
||||
# We need to force Emacs not to indent the Python code:
|
||||
# -*- org-src-preserve-indentation: t
|
||||
|
||||
#+begin_src python :var table=table-exit-codes :results drawer :exports none
|
||||
""" This script generates the C and Fortran constants for the error
|
||||
codes from the org-mode table.
|
||||
"""
|
||||
|
||||
result = [ "#+begin_src c :comments org :tangle (eval h_type) :exports none" ]
|
||||
for (text, code,_) in table:
|
||||
text=text.replace("~","")
|
||||
result += [ f"#define {text:30s} ((qmckl_exit_code) {code:d})" ]
|
||||
result += [ "#+end_src" ]
|
||||
|
||||
result += [ "" ]
|
||||
|
||||
result += [ "#+begin_src f90 :comments org :tangle (eval fh_type) :exports none" ]
|
||||
for (text, code,_) in table:
|
||||
text=text.replace("~","")
|
||||
result += [ f" integer(qmckl_exit_code), parameter :: {text:30s} = {code:d}" ]
|
||||
result += [ "#+end_src" ]
|
||||
|
||||
return '\n'.join(result)
|
||||
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
:results:
|
||||
#+begin_src c :comments org :tangle (eval h_type) :exports none
|
||||
#define QMCKL_SUCCESS ((qmckl_exit_code) 0)
|
||||
#define QMCKL_INVALID_ARG_1 ((qmckl_exit_code) 1)
|
||||
#define QMCKL_INVALID_ARG_2 ((qmckl_exit_code) 2)
|
||||
#define QMCKL_INVALID_ARG_3 ((qmckl_exit_code) 3)
|
||||
#define QMCKL_INVALID_ARG_4 ((qmckl_exit_code) 4)
|
||||
#define QMCKL_INVALID_ARG_5 ((qmckl_exit_code) 5)
|
||||
#define QMCKL_INVALID_ARG_6 ((qmckl_exit_code) 6)
|
||||
#define QMCKL_INVALID_ARG_7 ((qmckl_exit_code) 7)
|
||||
#define QMCKL_INVALID_ARG_8 ((qmckl_exit_code) 8)
|
||||
#define QMCKL_INVALID_ARG_9 ((qmckl_exit_code) 9)
|
||||
#define QMCKL_INVALID_ARG_10 ((qmckl_exit_code) 10)
|
||||
#define QMCKL_FAILURE ((qmckl_exit_code) 101)
|
||||
#define QMCKL_ERRNO ((qmckl_exit_code) 102)
|
||||
#define QMCKL_INVALID_CONTEXT ((qmckl_exit_code) 103)
|
||||
#define QMCKL_ALLOCATION_FAILED ((qmckl_exit_code) 104)
|
||||
#define QMCKL_DEALLOCATION_FAILED ((qmckl_exit_code) 105)
|
||||
#define QMCKL_INVALID_EXIT_CODE ((qmckl_exit_code) 106)
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval fh_type) :exports none
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_SUCCESS = 0
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_1 = 1
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_2 = 2
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_3 = 3
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_4 = 4
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_5 = 5
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_6 = 6
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_7 = 7
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_8 = 8
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_9 = 9
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_ARG_10 = 10
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_FAILURE = 101
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_ERRNO = 102
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_CONTEXT = 103
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_ALLOCATION_FAILED = 104
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_DEALLOCATION_FAILED = 105
|
||||
integer(qmckl_exit_code), parameter :: QMCKL_INVALID_EXIT_CODE = 106
|
||||
#+end_src
|
||||
:end:
|
||||
|
||||
The ~qmckl_string_of_error~ converts an exit code into a string. The
|
||||
string is assumed to be large enough to contain the error message
|
||||
(typically 128 characters).
|
||||
|
||||
* Decoding errors
|
||||
|
||||
To decode the error messages, ~qmckl_string_of_error~ converts an
|
||||
error code into a string.
|
||||
|
||||
#+NAME: MAX_STRING_LENGTH
|
||||
: 128
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none :noweb yes
|
||||
const char* qmckl_string_of_error(const qmckl_exit_code error);
|
||||
void qmckl_string_of_error_f(const qmckl_exit_code error,
|
||||
char result[<<MAX_STRING_LENGTH()>>]);
|
||||
#+end_src
|
||||
|
||||
The text strings are extracted from the previous table.
|
||||
|
||||
#+NAME:cases
|
||||
#+begin_src python :var table=table-exit-codes :exports none :noweb yes
|
||||
""" This script extracts the text associated with the error codes
|
||||
from the table.
|
||||
"""
|
||||
|
||||
result = []
|
||||
for (text, code, message) in table:
|
||||
text = text.replace("~","")
|
||||
message = message.replace("'",'"')
|
||||
result += [ f"""case {text}:
|
||||
return {message};
|
||||
break;""" ]
|
||||
return '\n'.join(result)
|
||||
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes
|
||||
const char* qmckl_string_of_error(const qmckl_exit_code error) {
|
||||
switch (error) {
|
||||
<<cases()>>
|
||||
}
|
||||
return "Unknown error";
|
||||
}
|
||||
|
||||
void qmckl_string_of_error_f(const qmckl_exit_code error, char result[<<MAX_STRING_LENGTH()>>]) {
|
||||
strncpy(result, qmckl_string_of_error(error), <<MAX_STRING_LENGTH()>>);
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
#+begin_src f90 :tangle (eval fh_func) :noexport :noweb yes
|
||||
interface
|
||||
subroutine qmckl_string_of_error (error, string) bind(C, name='qmckl_string_of_error_f')
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_exit_code), intent(in), value :: error
|
||||
character, intent(out) :: string(<<MAX_STRING_LENGTH()>>)
|
||||
end subroutine qmckl_string_of_error
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
* Data structure in context
|
||||
|
||||
The strings are declared with a maximum fixed size to avoid
|
||||
dynamic memory allocation.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_type)
|
||||
#define QMCKL_MAX_FUN_LEN 256
|
||||
#define QMCKL_MAX_MSG_LEN 1024
|
||||
|
||||
typedef struct qmckl_error_struct {
|
||||
|
||||
qmckl_exit_code exit_code;
|
||||
char function[QMCKL_MAX_FUN_LEN];
|
||||
char message [QMCKL_MAX_MSG_LEN];
|
||||
|
||||
} qmckl_error_struct;
|
||||
#+end_src
|
||||
|
||||
* Updating errors in the context
|
||||
|
||||
The error is updated in the context using ~qmckl_set_error~.
|
||||
When the error is set in the context, it is mandatory to specify
|
||||
from which function the error is triggered, and a message
|
||||
explaining the error. The exit code can't be ~QMCKL_SUCCESS~.
|
||||
|
||||
# Header
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
qmckl_exit_code
|
||||
qmckl_set_error(qmckl_context context,
|
||||
const qmckl_exit_code exit_code,
|
||||
const char* function_name,
|
||||
const char* message);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
qmckl_exit_code
|
||||
qmckl_set_error(qmckl_context context,
|
||||
const qmckl_exit_code exit_code,
|
||||
const char* function_name,
|
||||
const char* message)
|
||||
{
|
||||
/* Passing a function name and a message is mandatory. */
|
||||
assert (function_name != NULL);
|
||||
assert (message != NULL);
|
||||
|
||||
/* Exit codes are assumed valid. */
|
||||
assert (exit_code >= 0);
|
||||
assert (exit_code != QMCKL_SUCCESS);
|
||||
assert (exit_code < QMCKL_INVALID_EXIT_CODE);
|
||||
|
||||
/* The context is assumed to exist. */
|
||||
assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT);
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
assert (ctx != NULL); /* Impossible because the context is valid. */
|
||||
|
||||
ctx->error.exit_code = exit_code;
|
||||
strncpy(ctx->error.function, function_name, QMCKL_MAX_FUN_LEN);
|
||||
strncpy(ctx->error.message, message, QMCKL_MAX_MSG_LEN);
|
||||
}
|
||||
qmckl_unlock(context);
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
* Failing
|
||||
|
||||
To make a function fail, the ~qmckl_failwith~ function should be
|
||||
called, such that information about the failure is stored in
|
||||
the context. The desired exit code is given as an argument, as
|
||||
well as the name of the function and an error message. If the
|
||||
message is ~NULL~, then the default message obtained by
|
||||
~qmckl_string_of_error~ is used. The return code of the function is
|
||||
the desired return code.
|
||||
Upon failure, a ~QMCKL_NULL_CONTEXT~ is returned.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
qmckl_exit_code qmckl_failwith(qmckl_context context,
|
||||
const qmckl_exit_code exit_code,
|
||||
const char* function,
|
||||
const char* message) ;
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c)
|
||||
qmckl_exit_code qmckl_failwith(qmckl_context context,
|
||||
const qmckl_exit_code exit_code,
|
||||
const char* function,
|
||||
const char* message) {
|
||||
|
||||
assert (exit_code > 0);
|
||||
assert (exit_code < QMCKL_INVALID_EXIT_CODE);
|
||||
assert (function != NULL);
|
||||
assert (strlen(function) < QMCKL_MAX_FUN_LEN);
|
||||
if (message != NULL) {
|
||||
assert (strlen(message) < QMCKL_MAX_MSG_LEN);
|
||||
}
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT)
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
|
||||
if (message == NULL) {
|
||||
qmckl_exit_code rc =
|
||||
qmckl_set_error(context, exit_code, function, qmckl_string_of_error(exit_code));
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
} else {
|
||||
qmckl_exit_code rc =
|
||||
qmckl_set_error(context, exit_code, function, message);
|
||||
assert (rc == QMCKL_SUCCESS);
|
||||
}
|
||||
|
||||
return exit_code;
|
||||
}
|
||||
|
||||
#+end_src
|
||||
|
||||
For example, this function can be used as
|
||||
#+begin_src c :tangle no
|
||||
if (x < 0) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_function",
|
||||
"Expected x >= 0");
|
||||
}
|
||||
#+end_src
|
||||
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
#+begin_src c :comments link :tangle (eval h_private_type)
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
|
||||
** Test
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
return MUNIT_OK;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# -*- mode: org -*-
|
||||
# vim: syntax=c
|
||||
|
||||
|
@ -1,18 +0,0 @@
|
||||
* 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
|
||||
#endif
|
||||
#+END_SRC
|
||||
|
||||
#+BEGIN_SRC f90 :tangle qmckl_f.f90
|
||||
end module qmckl
|
||||
#+END_SRC
|
||||
|
||||
|
||||
# -*- mode: org -*-
|
||||
|
@ -1,101 +1,282 @@
|
||||
** Memory management
|
||||
#+TITLE: Memory management
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
#+INCLUDE: ../tools/lib.org
|
||||
|
||||
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=
|
||||
|
||||
*** Headers :noexport:
|
||||
#+BEGIN_SRC C :tangle qmckl_memory.c
|
||||
#include "qmckl.h"
|
||||
#+END_SRC
|
||||
* Headers :noexport:
|
||||
|
||||
#+BEGIN_SRC C :tangle test_qmckl_memory.c
|
||||
#+begin_src c :tangle (eval c)
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "qmckl_error_type.h"
|
||||
#include "qmckl_memory_private_type.h"
|
||||
#include "qmckl_context_type.h"
|
||||
#include "qmckl_context_private_type.h"
|
||||
|
||||
#include "qmckl_memory_private_func.h"
|
||||
#include "qmckl_memory_func.h"
|
||||
#include "qmckl_context_func.h"
|
||||
#include "qmckl_error_func.h"
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
MunitResult test_qmckl_memory() {
|
||||
#+END_SRC
|
||||
#include "qmckl_context_private_type.h"
|
||||
#include "qmckl_memory_private_func.h"
|
||||
MunitResult test_<<filename()>>() {
|
||||
#+end_src
|
||||
|
||||
*** =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 (eval h_private_type) :noweb yes
|
||||
#ifndef QMCKL_MEMORY_HPT
|
||||
#define QMCKL_MEMORY_HPT
|
||||
|
||||
#+BEGIN_SRC C :tangle qmckl.h
|
||||
void* qmckl_malloc(const qmckl_context ctx, const size_t size);
|
||||
#+END_SRC
|
||||
#include <stdint.h>
|
||||
#include <malloc.h>
|
||||
#+end_src
|
||||
|
||||
#+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
|
||||
* Memory data structure for the context
|
||||
|
||||
Every time a new block of memory is allocated, the information
|
||||
relative to the allocation is stored in a new ~qmckl_memory_info_struct~.
|
||||
A ~qmckl_memory_info_struct~ contains the pointer to the memory block,
|
||||
its size in bytes, and extra implementation-specific information such as
|
||||
alignment, pinning, if the memory should be allocated on CPU or GPU
|
||||
/etc/.
|
||||
|
||||
**** 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 */
|
||||
return malloc( (size_t) size );
|
||||
#+begin_src c :tangle (eval h_private_type) :noweb yes
|
||||
typedef struct qmckl_memory_info_struct {
|
||||
size_t size;
|
||||
void* pointer;
|
||||
} qmckl_memory_info_struct;
|
||||
|
||||
static const qmckl_memory_info_struct qmckl_memory_info_struct_zero =
|
||||
{
|
||||
.size = (size_t) 0,
|
||||
.pointer = NULL
|
||||
};
|
||||
#+end_src
|
||||
|
||||
The ~memory~ element of the context is a data structure which
|
||||
contains an array of ~qmckl_memory_info_struct~, the size of the
|
||||
array, and the number of allocated blocks.
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type) :noweb yes
|
||||
typedef struct qmckl_memory_struct {
|
||||
size_t n_allocated;
|
||||
size_t array_size;
|
||||
qmckl_memory_info_struct* element;
|
||||
} qmckl_memory_struct;
|
||||
#+end_src
|
||||
|
||||
* Passing info to allocation routines
|
||||
|
||||
Passing information to the allocation routine should be done by
|
||||
passing an instance of a ~qmckl_memory_info_struct~.
|
||||
|
||||
* Allocation/deallocation functions
|
||||
|
||||
Memory allocation inside the library should be done with
|
||||
~qmckl_malloc~. It lets the library choose how the memory will be
|
||||
allocated, and a pointer is returned to the user. The context is
|
||||
passed to let the library store data related to the allocation
|
||||
inside the context. In this particular implementation of the library,
|
||||
we store a list of allocated pointers so that all the memory can be
|
||||
properly freed when the library is de-initialized.
|
||||
If the allocation failed, the ~NULL~ pointer is returned.
|
||||
|
||||
# Header
|
||||
#+begin_src c :tangle (eval h_private_func) :noexport
|
||||
void* qmckl_malloc(qmckl_context context,
|
||||
const qmckl_memory_info_struct info);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
void* qmckl_malloc(qmckl_context context, const qmckl_memory_info_struct info) {
|
||||
|
||||
assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT);
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
|
||||
/* Allocate memory and zero it */
|
||||
void * pointer = malloc(info.size);
|
||||
if (pointer == NULL) {
|
||||
return NULL;
|
||||
}
|
||||
return malloc( (size_t) size );
|
||||
memset(pointer, 0, info.size);
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
/* If qmckl_memory_struct is full, reallocate a larger one */
|
||||
if (ctx->memory.n_allocated == ctx->memory.array_size) {
|
||||
const size_t old_size = ctx->memory.array_size;
|
||||
qmckl_memory_info_struct * new_array = reallocarray(ctx->memory.element,
|
||||
2L * old_size,
|
||||
sizeof(qmckl_memory_info_struct));
|
||||
if (new_array == NULL) {
|
||||
qmckl_unlock(context);
|
||||
free(pointer);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
memset( &(new_array[old_size]), 0, old_size * sizeof(qmckl_memory_info_struct) );
|
||||
ctx->memory.element = new_array;
|
||||
ctx->memory.array_size = 2L * old_size;
|
||||
}
|
||||
|
||||
/* Find first NULL entry */
|
||||
size_t pos = (size_t) 0;
|
||||
while ( pos < ctx->memory.array_size && ctx->memory.element[pos].size > (size_t) 0) {
|
||||
pos += (size_t) 1;
|
||||
}
|
||||
assert (ctx->memory.element[pos].size == (size_t) 0);
|
||||
|
||||
/* Copy info at the new location */
|
||||
ctx->memory.element[pos].size = info.size;
|
||||
ctx->memory.element[pos].pointer = pointer;
|
||||
ctx->memory.n_allocated += (size_t) 1;
|
||||
}
|
||||
qmckl_unlock(context);
|
||||
|
||||
return pointer;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
#+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
|
||||
# Test :noexport:
|
||||
#+begin_src c :tangle (eval c_test)
|
||||
/* Create a context */
|
||||
qmckl_context context = qmckl_context_create();
|
||||
|
||||
*** =qmckl_free=
|
||||
qmckl_memory_info_struct info = qmckl_memory_info_struct_zero;
|
||||
info.size = (size_t) 3;
|
||||
|
||||
#+BEGIN_SRC C :tangle qmckl.h
|
||||
void qmckl_free(void *ptr);
|
||||
#+END_SRC
|
||||
/* Allocate an array of ints */
|
||||
int *a = (int*) qmckl_malloc(context, info);
|
||||
|
||||
#+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);
|
||||
/* Check that array of ints is OK */
|
||||
munit_assert(a != NULL);
|
||||
a[0] = 1; munit_assert_int(a[0], ==, 1);
|
||||
a[1] = 2; munit_assert_int(a[1], ==, 2);
|
||||
a[2] = 3; munit_assert_int(a[2], ==, 3);
|
||||
|
||||
/* Allocate another array of ints */
|
||||
int *b = (int*) qmckl_malloc(context, info);
|
||||
|
||||
/* Check that array of ints is OK */
|
||||
munit_assert(b != NULL);
|
||||
b[0] = 1; munit_assert_int(b[0], ==, 1);
|
||||
b[1] = 2; munit_assert_int(b[1], ==, 2);
|
||||
b[2] = 3; munit_assert_int(b[2], ==, 3);
|
||||
#+end_src
|
||||
|
||||
When freeing the memory with ~qmckl_free~, the context is passed, in
|
||||
case some important information has been stored related to memory
|
||||
allocation and needs to be updated.
|
||||
|
||||
#+begin_src c :tangle (eval h_func)
|
||||
qmckl_exit_code qmckl_free(qmckl_context context,
|
||||
void * const ptr);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
qmckl_exit_code qmckl_free(qmckl_context context, void * const ptr) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_CONTEXT,
|
||||
"qmckl_free",
|
||||
NULL);
|
||||
}
|
||||
|
||||
if (ptr == NULL) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_free",
|
||||
"NULL pointer");
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
/* Find pointer in array of saved pointers */
|
||||
size_t pos = (size_t) 0;
|
||||
while ( pos < ctx->memory.array_size && ctx->memory.element[pos].pointer != ptr) {
|
||||
pos += (size_t) 1;
|
||||
}
|
||||
|
||||
if (pos >= ctx->memory.array_size) {
|
||||
/* Not found */
|
||||
qmckl_unlock(context);
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_FAILURE,
|
||||
"qmckl_free",
|
||||
"Pointer not found in context");
|
||||
}
|
||||
|
||||
free(ptr);
|
||||
|
||||
memset( &(ctx->memory.element[pos]), 0, sizeof(qmckl_memory_info_struct) );
|
||||
ctx->memory.n_allocated -= (size_t) 1;
|
||||
}
|
||||
qmckl_unlock(context);
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+END_SRC
|
||||
#+end_src
|
||||
|
||||
**** Test :noexport:
|
||||
#+BEGIN_SRC C :tangle test_qmckl_memory.c
|
||||
qmckl_free(a);
|
||||
#+END_SRC
|
||||
# Test
|
||||
#+begin_src c :tangle (eval c_test) :exports none
|
||||
qmckl_exit_code rc;
|
||||
/* Assert that both arrays are allocated */
|
||||
munit_assert(a != NULL);
|
||||
munit_assert(b != NULL);
|
||||
|
||||
*** End of files :noexport:
|
||||
/* Free in NULL context */
|
||||
rc = qmckl_free(QMCKL_NULL_CONTEXT, a);
|
||||
munit_assert(rc == QMCKL_INVALID_CONTEXT);
|
||||
|
||||
**** Test
|
||||
#+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c
|
||||
/* Free NULL pointer */
|
||||
rc = qmckl_free(context, NULL);
|
||||
munit_assert(rc == QMCKL_INVALID_ARG_2);
|
||||
|
||||
/* Free for the first time */
|
||||
rc = qmckl_free(context, a);
|
||||
munit_assert(rc == QMCKL_SUCCESS);
|
||||
|
||||
/* Free again */
|
||||
rc = qmckl_free(context, a);
|
||||
munit_assert(rc == QMCKL_FAILURE);
|
||||
|
||||
/* Clean up */
|
||||
rc = qmckl_context_destroy(context);
|
||||
munit_assert(rc == QMCKL_SUCCESS);
|
||||
|
||||
#+end_src
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_type)
|
||||
#endif
|
||||
|
||||
#+end_src
|
||||
** Test
|
||||
#+begin_src c :comments org :tangle (eval c_test)
|
||||
return MUNIT_OK;
|
||||
}
|
||||
|
||||
#+END_SRC
|
||||
#+end_src
|
||||
|
||||
|
||||
# -*- mode: org -*-
|
||||
# vim: syntax=c
|
||||
# -*- mode: org -*-
|
||||
# vim: syntax=c
|
||||
|
324
src/qmckl_numprec.org
Normal file
324
src/qmckl_numprec.org
Normal file
@ -0,0 +1,324 @@
|
||||
#+TITLE: Numerical precision
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
#+INCLUDE: ../tools/lib.org
|
||||
|
||||
* Headers :noexport:
|
||||
|
||||
#+begin_src c :tangle (eval c_test) :noweb yes
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
MunitResult test_<<filename()>>() {
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval h_private_type)
|
||||
#ifndef QMCKL_NUMPREC_HPT
|
||||
#define QMCKL_NUMPREC_HPT
|
||||
|
||||
#include <stdint.h>
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :tangle (eval c)
|
||||
#include <stdint.h>
|
||||
#include <assert.h>
|
||||
#include <math.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "qmckl_error_type.h"
|
||||
#include "qmckl_context_type.h"
|
||||
#include "qmckl_context_private_type.h"
|
||||
#include "qmckl_numprec_type.h"
|
||||
|
||||
#include "qmckl_numprec_func.h"
|
||||
#include "qmckl_error_func.h"
|
||||
#include "qmckl_context_func.h"
|
||||
|
||||
#+end_src
|
||||
|
||||
* Control of the numerical precision
|
||||
|
||||
Controlling numerical precision enables optimizations. Here, the
|
||||
default parameters determining the target numerical precision and
|
||||
range are defined. Following the IEEE Standard for Floating-Point
|
||||
Arithmetic (IEEE 754),
|
||||
/precision/ refers to the number of significand bits and /range/
|
||||
refers to the number of exponent bits.
|
||||
|
||||
#+NAME: table-precision
|
||||
| ~QMCKL_DEFAULT_PRECISION~ | 53 |
|
||||
| ~QMCKL_DEFAULT_RANGE~ | 11 |
|
||||
|
||||
# We need to force Emacs not to indent the Python code:
|
||||
# -*- org-src-preserve-indentation: t
|
||||
|
||||
#+begin_src python :var table=table-precision :results drawer :exports results
|
||||
""" This script generates the C and Fortran constants from the org-mode table.
|
||||
"""
|
||||
|
||||
result = [ "#+begin_src c :comments org :tangle (eval h_type)" ]
|
||||
for (text, code) in table:
|
||||
text=text.replace("~","")
|
||||
result += [ f"#define {text:30s} {code:d}" ]
|
||||
result += [ "#+end_src" ]
|
||||
|
||||
result += [ "" ]
|
||||
|
||||
result += [ "#+begin_src f90 :comments org :tangle (eval fh_func) :exports none" ]
|
||||
for (text, code) in table:
|
||||
text=text.replace("~","")
|
||||
result += [ f" integer, parameter :: {text:30s} = {code:d}" ]
|
||||
result += [ "#+end_src" ]
|
||||
|
||||
return '\n'.join(result)
|
||||
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
:results:
|
||||
#+begin_src c :comments org :tangle (eval h_type)
|
||||
#define QMCKL_DEFAULT_PRECISION 53
|
||||
#define QMCKL_DEFAULT_RANGE 11
|
||||
#+end_src
|
||||
|
||||
#+begin_src f90 :comments org :tangle (eval fh_func) :exports none
|
||||
integer, parameter :: QMCKL_DEFAULT_PRECISION = 53
|
||||
integer, parameter :: QMCKL_DEFAULT_RANGE = 11
|
||||
#+end_src
|
||||
:end:
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_private_type)
|
||||
typedef struct qmckl_numprec_struct {
|
||||
uint32_t precision;
|
||||
uint32_t range;
|
||||
} qmckl_numprec_struct;
|
||||
#+end_src
|
||||
|
||||
The following functions set and get the required precision and
|
||||
range. ~precision~ is an integer between 2 and 53, and ~range~ is 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~.
|
||||
|
||||
* Precision
|
||||
~qmckl_context_set_numprec_precision~ modifies the parameter for the
|
||||
numerical precision in the context.
|
||||
|
||||
# Header
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
qmckl_exit_code qmckl_set_numprec_precision(const qmckl_context context, const int precision);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
qmckl_exit_code qmckl_set_numprec_precision(const qmckl_context context, const int precision) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT)
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
|
||||
if (precision < 2) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_update_numprec_precision",
|
||||
"precision < 2");
|
||||
}
|
||||
|
||||
if (precision > 53) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_update_numprec_precision",
|
||||
"precision > 53");
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
|
||||
/* This should be always true because the context is valid */
|
||||
assert (ctx != NULL);
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
ctx->numprec.precision = (uint32_t) precision;
|
||||
}
|
||||
qmckl_unlock(context);
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
|
||||
#+begin_src f90 :tangle (eval fh_func)
|
||||
interface
|
||||
integer (qmckl_exit_code) function qmckl_set_numprec_precision(context, precision) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), intent(in), value :: context
|
||||
integer (c_int32_t), intent(in), value :: precision
|
||||
end function qmckl_set_numprec_precision
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
~qmckl_get_numprec_precision~ returns the value of the numerical precision in the context.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
int32_t qmckl_get_numprec_precision(const qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
int qmckl_get_numprec_precision(const qmckl_context context) {
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_CONTEXT,
|
||||
"qmckl_get_numprec_precision",
|
||||
"");
|
||||
}
|
||||
|
||||
const qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
return ctx->numprec.precision;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
#+begin_src f90 :tangle (eval fh_func)
|
||||
interface
|
||||
integer (qmckl_exit_code) function qmckl_get_numprec_precision(context) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), intent(in), value :: context
|
||||
end function qmckl_get_numprec_precision
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
* Range
|
||||
|
||||
~qmckl_set_numprec_range~ modifies the parameter for the numerical
|
||||
range in a given context.
|
||||
|
||||
# Header
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
qmckl_exit_code qmckl_set_numprec_range(const qmckl_context context, const int range);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
qmckl_exit_code qmckl_set_numprec_range(const qmckl_context context, const int range) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT)
|
||||
return QMCKL_INVALID_CONTEXT;
|
||||
|
||||
if (range < 2) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_set_numprec_range",
|
||||
"range < 2");
|
||||
}
|
||||
|
||||
if (range > 11) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_ARG_2,
|
||||
"qmckl_set_numprec_range",
|
||||
"range > 11");
|
||||
}
|
||||
|
||||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
|
||||
/* This should be always true because the context is valid */
|
||||
assert (ctx != NULL);
|
||||
|
||||
qmckl_lock(context);
|
||||
{
|
||||
ctx->numprec.range = (uint32_t) range;
|
||||
}
|
||||
qmckl_unlock(context);
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
#+begin_src f90 :tangle (eval fh_func)
|
||||
interface
|
||||
integer (qmckl_exit_code) function qmckl_numprec_set_range(context, range) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), intent(in), value :: context
|
||||
integer (c_int32_t), intent(in), value :: range
|
||||
end function qmckl_numprec_set_range
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
~qmckl_get_numprec_range~ returns the value of the numerical range in the context.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
int32_t qmckl_context_get_range(const qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
int qmckl_get_numprec_range(const qmckl_context context) {
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return qmckl_failwith(context,
|
||||
QMCKL_INVALID_CONTEXT,
|
||||
"qmckl_get_numprec_range",
|
||||
"");
|
||||
}
|
||||
|
||||
const qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||||
return ctx->numprec.range;
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
#+begin_src f90 :tangle (eval fh_func) :exports none
|
||||
interface
|
||||
integer (qmckl_exit_code) function qmckl_get_numprec_range(context) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), intent(in), value :: context
|
||||
end function qmckl_get_numprec_range
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
* Helper functions
|
||||
|
||||
~qmckl_get_numprec_epsilon~ returns $\epsilon = 2^{1-n}$ where ~n~ is the precision.
|
||||
We need to remove the sign bit from the precision.
|
||||
|
||||
#+begin_src c :comments org :tangle (eval h_func) :exports none
|
||||
double qmckl_get_numprec_epsilon(const qmckl_context context);
|
||||
#+end_src
|
||||
|
||||
# Source
|
||||
#+begin_src c :tangle (eval c)
|
||||
double qmckl_get_numprec_epsilon(const qmckl_context context) {
|
||||
const int precision = qmckl_get_numprec_precision(context);
|
||||
return 1. / (double) (1L << (precision-2));
|
||||
}
|
||||
#+end_src
|
||||
|
||||
# Fortran interface
|
||||
#+begin_src f90 :tangle (eval fh_func) :exports none
|
||||
interface
|
||||
real (c_double) function qmckl_get_numprec_epsilon(context) bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
integer (qmckl_context), intent(in), value :: context
|
||||
end function qmckl_get_numprec_epsilon
|
||||
end interface
|
||||
#+end_src
|
||||
|
||||
* End of files :noexport:
|
||||
|
||||
#+begin_src c :comments link :tangle (eval h_private_type)
|
||||
#endif
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
#+begin_src c :comments link :tangle (eval c_test)
|
||||
return MUNIT_OK;
|
||||
}
|
||||
#+end_src
|
||||
|
8
src/table_of_contents
Normal file
8
src/table_of_contents
Normal file
@ -0,0 +1,8 @@
|
||||
qmckl.org
|
||||
qmckl_error.org
|
||||
qmckl_context.org
|
||||
qmckl_memory.org
|
||||
qmckl_electron.org
|
||||
qmckl_ao.org
|
||||
qmckl_distance.org
|
||||
test_qmckl.org
|
@ -1,74 +1,91 @@
|
||||
#+TITLE: Testing
|
||||
#+SETUPFILE: ../docs/theme.setup
|
||||
|
||||
* QMCkl test :noexport:
|
||||
|
||||
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:
|
||||
First, we use a script to find the list of all the generated 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
|
||||
#+begin_src sh :exports none
|
||||
FILES=$(cat table_of_contents)
|
||||
grep begin_src $FILES \
|
||||
| grep c_test \
|
||||
| cut -d '.' -f 1 \
|
||||
| uniq
|
||||
#+end_src
|
||||
|
||||
#+RESULTS: test-files
|
||||
| test_qmckl_ao.c |
|
||||
| test_qmckl_context.c |
|
||||
| test_qmckl_distance.c |
|
||||
| test_qmckl_memory.c |
|
||||
| qmckl_error |
|
||||
| qmckl_context |
|
||||
| qmckl_memory |
|
||||
| qmckl_electron |
|
||||
| qmckl_ao |
|
||||
| qmckl_distance |
|
||||
|
||||
We generate the function headers
|
||||
#+BEGIN_SRC sh :var files=test-files :exports output :results raw
|
||||
#+begin_src sh :var files=test-files :exports output :results drawer
|
||||
echo "#+NAME: headers"
|
||||
echo "#+BEGIN_SRC C :tangle no"
|
||||
echo "#+begin_src c :tangle no"
|
||||
for file in $files
|
||||
do
|
||||
routine=${file%.c}
|
||||
routine=test_${file%.c}
|
||||
echo "MunitResult ${routine}();"
|
||||
done
|
||||
echo "#+END_SRC"
|
||||
#+END_SRC
|
||||
echo "#+end_src"
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
: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
|
||||
|
||||
#+begin_src c :tangle no
|
||||
MunitResult test_qmckl_error();
|
||||
MunitResult test_qmckl_context();
|
||||
MunitResult test_qmckl_memory();
|
||||
MunitResult test_qmckl_electron();
|
||||
MunitResult test_qmckl_ao();
|
||||
MunitResult test_qmckl_distance();
|
||||
#+end_src
|
||||
:end:
|
||||
|
||||
and the required function calls:
|
||||
#+BEGIN_SRC sh :var files=test-files :exports output :results raw
|
||||
#+begin_src sh :var files=test-files :exports output :results drawer
|
||||
echo "#+NAME: calls"
|
||||
echo "#+BEGIN_SRC C :tangle no"
|
||||
echo "#+begin_src c :tangle no"
|
||||
for file in $files
|
||||
do
|
||||
routine=${file%.c}
|
||||
routine=test_${file%.c}
|
||||
echo " { (char*) \"${routine}\", ${routine}, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},"
|
||||
done
|
||||
echo "#+END_SRC"
|
||||
#+END_SRC
|
||||
echo "#+end_src"
|
||||
#+end_src
|
||||
|
||||
#+RESULTS:
|
||||
: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
|
||||
#+begin_src c :tangle no
|
||||
{ (char*) "test_qmckl_error", test_qmckl_error, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
|
||||
{ (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},
|
||||
{ (char*) "test_qmckl_electron", test_qmckl_electron, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
|
||||
{ (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
|
||||
{ (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
|
||||
#+end_src
|
||||
:end:
|
||||
|
||||
#+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c
|
||||
We include the =mcheck.h= header to enable the debugging of
|
||||
allocations with ~mtrace~. Memory allocations will be traced in the
|
||||
file specified by the ~MALLOC_TRACE~ environment variable.
|
||||
|
||||
#+begin_src c :comments link :noweb yes :tangle test_qmckl.c
|
||||
#include "qmckl.h"
|
||||
#include "munit.h"
|
||||
#include "mcheck.h"
|
||||
<<headers>>
|
||||
|
||||
int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) {
|
||||
mtrace();
|
||||
static MunitTest test_suite_tests[] =
|
||||
{
|
||||
<<calls>>
|
||||
@ -80,6 +97,10 @@ int main(int argc, char* argv[MUNIT_ARRAY_PARAM(argc + 1)]) {
|
||||
(char*) "", test_suite_tests, NULL, 1, MUNIT_SUITE_OPTION_NONE
|
||||
};
|
||||
|
||||
return munit_suite_main(&test_suite, (void*) "µnit", argc, argv);
|
||||
|
||||
int result = munit_suite_main(&test_suite, (void*) "µnit", argc, argv);
|
||||
muntrace();
|
||||
return result;
|
||||
}
|
||||
#+END_SRC
|
||||
#+end_src
|
||||
|
||||
|
619
tools/Building.org
Normal file
619
tools/Building.org
Normal file
@ -0,0 +1,619 @@
|
||||
#+TITLE: Building tools
|
||||
|
||||
This file contains all the tools needed to build the QMCkl library.
|
||||
|
||||
* Helper functions
|
||||
#+NAME: header
|
||||
#+begin_src sh :tangle no :exports none :output none
|
||||
echo "This file was created by tools/Building.org"
|
||||
#+end_src
|
||||
|
||||
#+NAME: check-src
|
||||
#+begin_src bash
|
||||
if [[ $(basename ${PWD}) != "src" ]] ; then
|
||||
echo "This script needs to be run in the src directory"
|
||||
exit -1
|
||||
fi
|
||||
#+end_src
|
||||
|
||||
#+NAME: url-issues
|
||||
: https://github.com/trex-coe/qmckl/issues
|
||||
|
||||
#+NAME: url-web
|
||||
: https://trex-coe.github.io/qmckl
|
||||
|
||||
#+NAME: license
|
||||
#+begin_example
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2020, TREX Center of Excellence
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
3. Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
#+end_example
|
||||
|
||||
* Makefile
|
||||
:PROPERTIES:
|
||||
:header-args: :tangle ../src/Makefile :noweb yes :comments org
|
||||
:END:
|
||||
|
||||
This is the main Makefile invoked by the ~make~ command.
|
||||
The Makefile compiling the library is =Makefile.generated=, and is
|
||||
generated by the script detailed in the next section.
|
||||
** Header :noexport:
|
||||
|
||||
#+begin_src makefile
|
||||
# <<header()>>
|
||||
|
||||
.POSIX:
|
||||
#+end_src
|
||||
** Dependencies
|
||||
|
||||
#+begin_src makefile
|
||||
LIBS=-lpthread
|
||||
#+end_src
|
||||
|
||||
** Variables
|
||||
|
||||
#+begin_src makefile
|
||||
QMCKL_ROOT=$(shell dirname $(CURDIR))
|
||||
|
||||
shared_lib=$(QMCKL_ROOT)/lib/libqmckl.so
|
||||
static_lib=$(QMCKL_ROOT)/lib/libqmckl.a
|
||||
qmckl_h=$(QMCKL_ROOT)/include/qmckl.h
|
||||
qmckl_f=$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90
|
||||
|
||||
export CC CFLAGS FC FFLAGS LIBS QMCKL_ROOT
|
||||
|
||||
ORG_SOURCE_FILES=$(wildcard *.org)
|
||||
C_SOURCE_FILES=$(patsubst %.org,%.c,$(ORG_SOURCE_FILES))
|
||||
INCLUDE=-I$(QMCKL_ROOT)/include/
|
||||
#+end_src
|
||||
|
||||
** Compiler options
|
||||
|
||||
GNU, Intel and LLVM compilers are supported. Choose here:
|
||||
|
||||
#+begin_src makefile
|
||||
COMPILER=GNU
|
||||
#COMPILER=INTEL
|
||||
#COMPILER=LLVM
|
||||
#+end_src
|
||||
|
||||
*** GNU
|
||||
|
||||
#+begin_src makefile
|
||||
ifeq ($(COMPILER),GNU)
|
||||
#----------------------------------------------------------
|
||||
CC=gcc -g
|
||||
CFLAGS=-fPIC $(INCLUDE) \
|
||||
-fexceptions -Wall -Werror -Wpedantic -Wextra -fmax-errors=3
|
||||
|
||||
FC=gfortran -g
|
||||
FFLAGS=-fPIC $(INCLUDE) \
|
||||
-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising \
|
||||
-Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation \
|
||||
-Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \
|
||||
-ffpe-trap=zero,overflow,underflow
|
||||
|
||||
LIBS+=-lgfortran -lm
|
||||
#----------------------------------------------------------
|
||||
endif
|
||||
#+end_src
|
||||
|
||||
*** Intel
|
||||
|
||||
#+begin_src makefile
|
||||
ifeq ($(COMPILER),INTEL)
|
||||
#----------------------------------------------------------
|
||||
CC=icc -xHost
|
||||
CFLAGS=-fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
FC=ifort -xHost
|
||||
FFLAGS=-fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
LIBS+=-lm -lifcore -lirc
|
||||
#----------------------------------------------------------
|
||||
CC=icc -xHost
|
||||
endif
|
||||
#+end_src
|
||||
|
||||
*** LLVM
|
||||
|
||||
#+begin_src makefile
|
||||
ifeq ($(COMPILER),LLVM)
|
||||
#----------------------------------------------------------
|
||||
CC=clang
|
||||
CFLAGS=-fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
FC=flang
|
||||
FFLAGS=fPIC -g -O2 $(INCLUDE)
|
||||
|
||||
LIBS+=-lm
|
||||
#----------------------------------------------------------
|
||||
endif
|
||||
#+end_src
|
||||
|
||||
** Rules
|
||||
|
||||
The source files are created during the generation of the file ~Makefile.generated~.
|
||||
The Makefile.generated is the one that will be distributed with the library.
|
||||
|
||||
#+begin_src makefile
|
||||
.PHONY: clean shared static doc all check install uninstall
|
||||
.SECONDARY: # Needed to keep the produced C and Fortran files
|
||||
|
||||
$(shared_lib) $(static_lib) install uninstall: $(qmckl_h) $(qmckl_f) Makefile.generated
|
||||
$(MAKE) -f Makefile.generated $@
|
||||
|
||||
$(qmckl_f) $(qmckl_h): Makefile.generated
|
||||
$(QMCKL_ROOT)/tools/build_qmckl_h.sh
|
||||
|
||||
shared: $(shared_lib)
|
||||
static: $(static_lib)
|
||||
all: shared static doc check
|
||||
|
||||
check: $(static_lib)
|
||||
$(MAKE) -f Makefile.generated check
|
||||
|
||||
doc: $(ORG_SOURCE_FILES)
|
||||
$(QMCKL_ROOT)/tools/build_doc.sh
|
||||
|
||||
clean:
|
||||
- $(MAKE) -f Makefile.generated clean
|
||||
- $(RM) test_qmckl_* test_qmckl.c \
|
||||
$(qmckl_h) $(qmckl_f) \
|
||||
qmckl_*.f90 qmckl_*.c qmckl_*.h \
|
||||
Makefile.generated *.html *.txt
|
||||
|
||||
veryclean: clean FORCE
|
||||
- $(RM) $(QMCKL_ROOT)/docs/*.html \
|
||||
$(QMCKL_ROOT)/docs/*.txt
|
||||
|
||||
Makefile.generated: Makefile $(QMCKL_ROOT)/tools/create_makefile.sh $(ORG_SOURCE_FILES)
|
||||
$(QMCKL_ROOT)/tools/create_makefile.sh
|
||||
|
||||
|
||||
.SUFFIXES: .org .c
|
||||
|
||||
.org.c:
|
||||
$(QMCKL_ROOT)/tools/tangle.sh $<
|
||||
|
||||
#+end_src
|
||||
|
||||
* Script to tangle the org-mode files
|
||||
:PROPERTIES:
|
||||
:header-args: :tangle tangle.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
:END:
|
||||
|
||||
#+begin_src bash
|
||||
# <<header()>>
|
||||
|
||||
<<check_src>>
|
||||
#+end_src
|
||||
|
||||
This file needs to be run from the QMCKL =src= directory.
|
||||
|
||||
It tangles all the files in the directory. It uses the
|
||||
=config_tangle.el= file, which contains information required to
|
||||
compute the current file names using for example ~(eval c)~ to get
|
||||
the name of the produced C file.
|
||||
|
||||
The file is not tangled if the last modification date of the org
|
||||
file is less recent than one of the tangled files.
|
||||
|
||||
#+begin_src bash
|
||||
function tangle()
|
||||
{
|
||||
local org_file=$1
|
||||
local c_file=${org_file%.org}.c
|
||||
local f_file=${org_file%.org}.f90
|
||||
|
||||
if [[ ${org_file} -ot ${c_file} ]] ; then
|
||||
return
|
||||
elif [[ ${org_file} -ot ${f_file} ]] ; then
|
||||
return
|
||||
fi
|
||||
emacs --batch ${org_file} --load=../tools/config_tangle.el -f org-babel-tangle
|
||||
}
|
||||
|
||||
for i in $@
|
||||
do
|
||||
echo "--- ${i} ----"
|
||||
tangle ${i}
|
||||
done
|
||||
#+end_src
|
||||
|
||||
* Script to generate auto-generated Makefile
|
||||
:PROPERTIES:
|
||||
:header-args: :tangle create_makefile.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
:END:
|
||||
|
||||
This script generates the Makefile that compiles the library.
|
||||
The ~OUTPUT~ variable contains the name of the generated Makefile,typically
|
||||
=Makefile.generated=.
|
||||
|
||||
#+begin_src bash
|
||||
# <<header()>>
|
||||
|
||||
<<check_src>>
|
||||
|
||||
OUTPUT=Makefile.generated
|
||||
#+end_src
|
||||
|
||||
We start by tangling all the org-mode files.
|
||||
|
||||
#+begin_src bash
|
||||
${QMCKL_ROOT}/tools/tangle.sh *.org
|
||||
${QMCKL_ROOT}/tools/build_qmckl_h.sh
|
||||
#+end_src
|
||||
|
||||
Then we create the list of ~*.o~ files to be created, for library
|
||||
functions:
|
||||
|
||||
#+begin_src bash
|
||||
OBJECTS="qmckl_f.o"
|
||||
for i in $(ls qmckl_*.c qmckl_*f.f90) ; do
|
||||
FILE=${i%.*}
|
||||
OBJECTS+=" ${FILE}.o"
|
||||
done >> $OUTPUT
|
||||
#+end_src
|
||||
|
||||
for tests in C:
|
||||
|
||||
#+begin_src bash
|
||||
TESTS=""
|
||||
for i in $(ls test_qmckl_*.c) ; do
|
||||
FILE=${i%.c}
|
||||
TESTS+=" ${FILE}.o"
|
||||
done >> $OUTPUT
|
||||
#+end_src
|
||||
|
||||
and for tests in Fortran:
|
||||
|
||||
#+begin_src bash
|
||||
TESTS_F=""
|
||||
for i in $(ls test_qmckl_*_f.f90) ; do
|
||||
FILE=${i%.f90}
|
||||
TESTS_F+=" ${FILE}.o"
|
||||
done >> $OUTPUT
|
||||
#+end_src
|
||||
|
||||
Finally, we append the rules to the Makefile
|
||||
|
||||
#+begin_src bash
|
||||
cat << EOF > ${OUTPUT}
|
||||
.POSIX:
|
||||
.SUFFIXES:
|
||||
|
||||
prefix=/usr/local
|
||||
|
||||
CC=$CC
|
||||
CFLAGS=$CFLAGS -I../munit/
|
||||
|
||||
FC=$FC
|
||||
FFLAGS=$FFLAGS
|
||||
|
||||
OBJECT_FILES=$OBJECTS
|
||||
TESTS=$TESTS
|
||||
TESTS_F=$TESTS_F
|
||||
|
||||
LIBS=$LIBS
|
||||
|
||||
QMCKL_ROOT=\$(shell dirname \$(CURDIR))
|
||||
shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so
|
||||
static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a
|
||||
qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h
|
||||
qmckl_f=\$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90
|
||||
munit=\$(QMCKL_ROOT)/munit/munit.c
|
||||
|
||||
shared: \$(shared_lib)
|
||||
static: \$(static_lib)
|
||||
all: shared static
|
||||
|
||||
\$(shared_lib): \$(OBJECT_FILES)
|
||||
\$(CC) -shared \$(OBJECT_FILES) -o \$(shared_lib)
|
||||
|
||||
\$(static_lib): \$(OBJECT_FILES)
|
||||
\$(AR) rcs \$(static_lib) \$(OBJECT_FILES)
|
||||
|
||||
|
||||
# Test
|
||||
|
||||
qmckl_f.o: \$(qmckl_f)
|
||||
\$(FC) \$(FFLAGS) -c \$(qmckl_f) -o \$@
|
||||
|
||||
test_qmckl: test_qmckl.c \$(qmckl_h) \$(static_lib) \$(TESTS) \$(TESTS_F)
|
||||
\$(CC) \$(CFLAGS) \
|
||||
\$(munit) \$(TESTS) \$(TESTS_F) \$(static_lib) \$(LIBS) test_qmckl.c -o \$@
|
||||
|
||||
test_qmckl_shared: test_qmckl.c \$(qmckl_h) \$(shared_lib) \$(TESTS) \$(TESTS_F)
|
||||
\$(CC) \$(CFLAGS) -Wl,-rpath,\$(QMCKL_ROOT)/lib -L\$(QMCKL_ROOT)/lib \
|
||||
\$(munit) \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o \$@
|
||||
|
||||
check: test_qmckl test_qmckl_shared
|
||||
./test_qmckl
|
||||
|
||||
clean:
|
||||
\$(RM) -- *.o *.mod \$(shared_lib) \$(static_lib) test_qmckl
|
||||
|
||||
install:
|
||||
install -d \$(prefix)/lib
|
||||
install -d \$(prefix)/include
|
||||
install -d \$(prefix)/share/qmckl/fortran
|
||||
install -d \$(prefix)/man
|
||||
install \$(shared_lib) \$(prefix)/lib
|
||||
install \$(static_lib) \$(prefix)/lib
|
||||
install \$(qmckl_h) \$(prefix)/include
|
||||
install \$(qmckl_f) \$(prefix)/share/qmckl/fortran
|
||||
|
||||
.SUFFIXES: .c .f90 .o
|
||||
|
||||
.c.o:
|
||||
\$(CC) \$(CFLAGS) -c \$*.c -o \$*.o
|
||||
|
||||
.f90.o: qmckl_f.o
|
||||
\$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o
|
||||
|
||||
.PHONY: check clean all
|
||||
EOF
|
||||
|
||||
#+end_src
|
||||
|
||||
* Script to build the final qmckl.h file
|
||||
:PROPERTIES:
|
||||
:header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
:END:
|
||||
|
||||
#+begin_src bash :noweb yes
|
||||
# <<header()>>
|
||||
|
||||
#+end_src
|
||||
|
||||
#+NAME: qmckl-header
|
||||
#+begin_src text :noweb yes
|
||||
------------------------------------------
|
||||
QMCkl - Quantum Monte Carlo kernel library
|
||||
------------------------------------------
|
||||
|
||||
Documentation : <<url-web()>>
|
||||
Issues : <<url-issues()>>
|
||||
|
||||
<<license()>>
|
||||
|
||||
|
||||
#+end_src
|
||||
|
||||
All the produced header files are concatenated in the =qmckl.h=
|
||||
file, located in the include directory. The =*_private.h= files
|
||||
are excluded.
|
||||
|
||||
Put =.h= files in the correct order:
|
||||
|
||||
#+begin_src bash
|
||||
HEADERS=""
|
||||
for i in $(cat table_of_contents)
|
||||
do
|
||||
HEADERS+="${i%.org}_type.h "
|
||||
done
|
||||
|
||||
for i in $(cat table_of_contents)
|
||||
do
|
||||
HEADERS+="${i%.org}_func.h "
|
||||
done
|
||||
#+end_src
|
||||
|
||||
Generate C header file
|
||||
|
||||
#+begin_src bash
|
||||
OUTPUT="../include/qmckl.h"
|
||||
|
||||
cat << EOF > ${OUTPUT}
|
||||
/*
|
||||
,* <<qmckl-header>>
|
||||
,*/
|
||||
|
||||
#ifndef __QMCKL_H__
|
||||
#define __QMCKL_H__
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <stdbool.h>
|
||||
EOF
|
||||
|
||||
for i in ${HEADERS}
|
||||
do
|
||||
if [[ -f $i ]] ; then
|
||||
cat $i >> ${OUTPUT}
|
||||
fi
|
||||
done
|
||||
|
||||
cat << EOF >> ${OUTPUT}
|
||||
#endif
|
||||
EOF
|
||||
#+end_src
|
||||
|
||||
Generate Fortran interface file from all =qmckl_*_fh.f90= files
|
||||
|
||||
#+begin_src bash
|
||||
HEADERS_TYPE="qmckl_*_fh_type.f90"
|
||||
HEADERS="qmckl_*_fh_func.f90"
|
||||
|
||||
OUTPUT="../share/qmckl/fortran/qmckl_f.f90"
|
||||
cat << EOF > ${OUTPUT}
|
||||
!
|
||||
! <<qmckl-header>>
|
||||
!
|
||||
module qmckl
|
||||
use, intrinsic :: iso_c_binding
|
||||
EOF
|
||||
|
||||
for i in ${HEADERS_TYPE}
|
||||
do
|
||||
cat $i >> ${OUTPUT}
|
||||
done
|
||||
|
||||
for i in ${HEADERS}
|
||||
do
|
||||
cat $i >> ${OUTPUT}
|
||||
done
|
||||
|
||||
cat << EOF >> ${OUTPUT}
|
||||
end module qmckl
|
||||
EOF
|
||||
#+end_src
|
||||
|
||||
* Script to build the documentation
|
||||
:PROPERTIES:
|
||||
:header-args:bash: :tangle build_doc.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
:END:
|
||||
|
||||
First define readonly global variables.
|
||||
|
||||
#+begin_src bash :noweb yes
|
||||
readonly DOCS=${QMCKL_ROOT}/docs/
|
||||
readonly SRC=${QMCKL_ROOT}/src/
|
||||
readonly HTMLIZE=${DOCS}/htmlize.el
|
||||
readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el
|
||||
readonly CONFIG_TANGLE=${QMCKL_ROOT}/tools/config_tangle.el
|
||||
#+end_src
|
||||
|
||||
Check that all the defined global variables correspond to files.
|
||||
|
||||
#+begin_src bash :noweb yes
|
||||
function check_preconditions()
|
||||
{
|
||||
if [[ -z ${QMCKL_ROOT} ]]
|
||||
then
|
||||
print "QMCKL_ROOT is not defined"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
for dir in ${DOCS} ${SRC}
|
||||
do
|
||||
if [[ ! -d ${dir} ]]
|
||||
then
|
||||
print "${dir} not found"
|
||||
exit 2
|
||||
fi
|
||||
done
|
||||
|
||||
for file in ${CONFIG_DOC} ${CONFIG_TANGLE}
|
||||
do
|
||||
if [[ ! -f ${file} ]]
|
||||
then
|
||||
print "${file} not found"
|
||||
exit 3
|
||||
fi
|
||||
done
|
||||
}
|
||||
#+end_src
|
||||
|
||||
~install_htmlize~ installs the htmlize Emacs plugin if the
|
||||
=htmlize.el= file is not present.
|
||||
|
||||
#+begin_src bash :noweb yes
|
||||
function install_htmlize()
|
||||
{
|
||||
local url="https://github.com/hniksic/emacs-htmlize"
|
||||
local repo="emacs-htmlize"
|
||||
|
||||
[[ -f ${HTMLIZE} ]] || (
|
||||
cd ${DOCS}
|
||||
git clone ${url} \
|
||||
&& cp ${repo}/htmlize.el ${HTMLIZE} \
|
||||
&& rm -rf ${repo}
|
||||
cd -
|
||||
)
|
||||
|
||||
# Assert htmlize is installed
|
||||
[[ -f ${HTMLIZE} ]] \
|
||||
|| exit 1
|
||||
}
|
||||
#+end_src
|
||||
|
||||
Extract documentation from an org-mode file.
|
||||
|
||||
#+begin_src bash :noweb yes
|
||||
function extract_doc()
|
||||
{
|
||||
local org=$1
|
||||
local local_html=${SRC}/${org%.org}.html
|
||||
local local_text=${SRC}/${org%.org}.txt
|
||||
local html=${DOCS}/${org%.org}.html
|
||||
|
||||
if [[ -f ${html} && ${org} -ot ${html} ]]
|
||||
then
|
||||
return
|
||||
fi
|
||||
emacs --batch \
|
||||
--load ${HTMLIZE} \
|
||||
--load ${CONFIG_DOC} \
|
||||
${org} \
|
||||
--load ${CONFIG_TANGLE} \
|
||||
-f org-html-export-to-html \
|
||||
-f org-ascii-export-to-ascii
|
||||
mv ${local_html} ${local_text} ${DOCS}
|
||||
|
||||
}
|
||||
#+end_src
|
||||
|
||||
The main function of the script.
|
||||
|
||||
#+begin_src bash :noweb yes
|
||||
function main() {
|
||||
|
||||
check_preconditions || exit 1
|
||||
|
||||
# Install htmlize if needed
|
||||
install_htmlize || exit 2
|
||||
|
||||
# Create documentation
|
||||
cd ${SRC} \
|
||||
|| exit 3
|
||||
|
||||
for i in *.org
|
||||
do
|
||||
echo
|
||||
echo "======= ${i} ======="
|
||||
extract_doc ${i}
|
||||
done
|
||||
|
||||
if [[ $? -eq 0 ]]
|
||||
then
|
||||
cd ${DOCS}
|
||||
rm -f index.html
|
||||
ln README.html index.html
|
||||
exit 0
|
||||
else
|
||||
exit 3
|
||||
fi
|
||||
}
|
||||
main
|
||||
#+end_src
|
||||
|
||||
|
132
tools/build_doc.sh
Executable file
132
tools/build_doc.sh
Executable file
@ -0,0 +1,132 @@
|
||||
#!/bin/bash
|
||||
# Script to build the documentation
|
||||
# :PROPERTIES:
|
||||
# :header-args:bash: :tangle build_doc.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
# :END:
|
||||
|
||||
# First define readonly global variables.
|
||||
|
||||
|
||||
readonly DOCS=${QMCKL_ROOT}/docs/
|
||||
readonly SRC=${QMCKL_ROOT}/src/
|
||||
readonly HTMLIZE=${DOCS}/htmlize.el
|
||||
readonly CONFIG_DOC=${QMCKL_ROOT}/tools/config_doc.el
|
||||
readonly CONFIG_TANGLE=${QMCKL_ROOT}/tools/config_tangle.el
|
||||
|
||||
|
||||
|
||||
# Check that all the defined global variables correspond to files.
|
||||
|
||||
|
||||
function check_preconditions()
|
||||
{
|
||||
if [[ -z ${QMCKL_ROOT} ]]
|
||||
then
|
||||
print "QMCKL_ROOT is not defined"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
for dir in ${DOCS} ${SRC}
|
||||
do
|
||||
if [[ ! -d ${dir} ]]
|
||||
then
|
||||
print "${dir} not found"
|
||||
exit 2
|
||||
fi
|
||||
done
|
||||
|
||||
for file in ${CONFIG_DOC} ${CONFIG_TANGLE}
|
||||
do
|
||||
if [[ ! -f ${file} ]]
|
||||
then
|
||||
print "${file} not found"
|
||||
exit 3
|
||||
fi
|
||||
done
|
||||
}
|
||||
|
||||
|
||||
|
||||
# ~install_htmlize~ installs the htmlize Emacs plugin if the
|
||||
# =htmlize.el= file is not present.
|
||||
|
||||
|
||||
function install_htmlize()
|
||||
{
|
||||
local url="https://github.com/hniksic/emacs-htmlize"
|
||||
local repo="emacs-htmlize"
|
||||
|
||||
[[ -f ${HTMLIZE} ]] || (
|
||||
cd ${DOCS}
|
||||
git clone ${url} \
|
||||
&& cp ${repo}/htmlize.el ${HTMLIZE} \
|
||||
&& rm -rf ${repo}
|
||||
cd -
|
||||
)
|
||||
|
||||
# Assert htmlize is installed
|
||||
[[ -f ${HTMLIZE} ]] \
|
||||
|| exit 1
|
||||
}
|
||||
|
||||
|
||||
|
||||
# Extract documentation from an org-mode file.
|
||||
|
||||
|
||||
function extract_doc()
|
||||
{
|
||||
local org=$1
|
||||
local local_html=${SRC}/${org%.org}.html
|
||||
local local_text=${SRC}/${org%.org}.txt
|
||||
local html=${DOCS}/${org%.org}.html
|
||||
|
||||
if [[ -f ${html} && ${org} -ot ${html} ]]
|
||||
then
|
||||
return
|
||||
fi
|
||||
emacs --batch \
|
||||
--load ${HTMLIZE} \
|
||||
--load ${CONFIG_DOC} \
|
||||
${org} \
|
||||
--load ${CONFIG_TANGLE} \
|
||||
-f org-html-export-to-html \
|
||||
-f org-ascii-export-to-ascii
|
||||
mv ${local_html} ${local_text} ${DOCS}
|
||||
|
||||
}
|
||||
|
||||
|
||||
|
||||
# The main function of the script.
|
||||
|
||||
|
||||
function main() {
|
||||
|
||||
check_preconditions || exit 1
|
||||
|
||||
# Install htmlize if needed
|
||||
install_htmlize || exit 2
|
||||
|
||||
# Create documentation
|
||||
cd ${SRC} \
|
||||
|| exit 3
|
||||
|
||||
for i in *.org
|
||||
do
|
||||
echo
|
||||
echo "======= ${i} ======="
|
||||
extract_doc ${i}
|
||||
done
|
||||
|
||||
if [[ $? -eq 0 ]]
|
||||
then
|
||||
cd ${DOCS}
|
||||
rm -f index.html
|
||||
ln README.html index.html
|
||||
exit 0
|
||||
else
|
||||
exit 3
|
||||
fi
|
||||
}
|
||||
main
|
168
tools/build_qmckl_h.sh
Executable file
168
tools/build_qmckl_h.sh
Executable file
@ -0,0 +1,168 @@
|
||||
#!/bin/bash
|
||||
# Script to build the final qmckl.h file
|
||||
# :PROPERTIES:
|
||||
# :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
# :END:
|
||||
|
||||
|
||||
# This file was created by tools/Building.org
|
||||
|
||||
|
||||
|
||||
# All the produced header files are concatenated in the =qmckl.h=
|
||||
# file, located in the include directory. The =*_private.h= files
|
||||
# are excluded.
|
||||
|
||||
# Put =.h= files in the correct order:
|
||||
|
||||
|
||||
HEADERS=""
|
||||
for i in $(cat table_of_contents)
|
||||
do
|
||||
HEADERS+="${i%.org}_type.h "
|
||||
done
|
||||
|
||||
for i in $(cat table_of_contents)
|
||||
do
|
||||
HEADERS+="${i%.org}_func.h "
|
||||
done
|
||||
|
||||
|
||||
|
||||
# Generate C header file
|
||||
|
||||
|
||||
OUTPUT="../include/qmckl.h"
|
||||
|
||||
cat << EOF > ${OUTPUT}
|
||||
/*
|
||||
* ------------------------------------------
|
||||
* QMCkl - Quantum Monte Carlo kernel library
|
||||
* ------------------------------------------
|
||||
*
|
||||
* Documentation : https://trex-coe.github.io/qmckl
|
||||
* Issues : https://github.com/trex-coe/qmckl/issues
|
||||
*
|
||||
* BSD 3-Clause License
|
||||
*
|
||||
* Copyright (c) 2020, TREX Center of Excellence
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright notice, this
|
||||
* list of conditions and the following disclaimer.
|
||||
*
|
||||
* 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
* this list of conditions and the following disclaimer in the documentation
|
||||
* and/or other materials provided with the distribution.
|
||||
*
|
||||
* 3. Neither the name of the copyright holder nor the names of its
|
||||
* contributors may be used to endorse or promote products derived from
|
||||
* this software without specific prior written permission.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
* AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
* CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
*
|
||||
*
|
||||
*
|
||||
*/
|
||||
|
||||
#ifndef __QMCKL_H__
|
||||
#define __QMCKL_H__
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <stdbool.h>
|
||||
EOF
|
||||
|
||||
for i in ${HEADERS}
|
||||
do
|
||||
if [[ -f $i ]] ; then
|
||||
cat $i >> ${OUTPUT}
|
||||
fi
|
||||
done
|
||||
|
||||
cat << EOF >> ${OUTPUT}
|
||||
#endif
|
||||
EOF
|
||||
|
||||
|
||||
|
||||
# Generate Fortran interface file from all =qmckl_*_fh.f90= files
|
||||
|
||||
|
||||
HEADERS_TYPE="qmckl_*_fh_type.f90"
|
||||
HEADERS="qmckl_*_fh_func.f90"
|
||||
|
||||
OUTPUT="../share/qmckl/fortran/qmckl_f.f90"
|
||||
cat << EOF > ${OUTPUT}
|
||||
!
|
||||
! ------------------------------------------
|
||||
! QMCkl - Quantum Monte Carlo kernel library
|
||||
! ------------------------------------------
|
||||
!
|
||||
! Documentation : https://trex-coe.github.io/qmckl
|
||||
! Issues : https://github.com/trex-coe/qmckl/issues
|
||||
!
|
||||
! BSD 3-Clause License
|
||||
!
|
||||
! Copyright (c) 2020, TREX Center of Excellence
|
||||
! All rights reserved.
|
||||
!
|
||||
! Redistribution and use in source and binary forms, with or without
|
||||
! modification, are permitted provided that the following conditions are met:
|
||||
!
|
||||
! 1. Redistributions of source code must retain the above copyright notice, this
|
||||
! list of conditions and the following disclaimer.
|
||||
!
|
||||
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
! this list of conditions and the following disclaimer in the documentation
|
||||
! and/or other materials provided with the distribution.
|
||||
!
|
||||
! 3. Neither the name of the copyright holder nor the names of its
|
||||
! contributors may be used to endorse or promote products derived from
|
||||
! this software without specific prior written permission.
|
||||
!
|
||||
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
! AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
! DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
! FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
! SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
!
|
||||
module qmckl
|
||||
use, intrinsic :: iso_c_binding
|
||||
EOF
|
||||
|
||||
for i in ${HEADERS_TYPE}
|
||||
do
|
||||
cat $i >> ${OUTPUT}
|
||||
done
|
||||
|
||||
for i in ${HEADERS}
|
||||
do
|
||||
cat $i >> ${OUTPUT}
|
||||
done
|
||||
|
||||
cat << EOF >> ${OUTPUT}
|
||||
end module qmckl
|
||||
EOF
|
@ -1,11 +1,22 @@
|
||||
;; 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 'htmlize)
|
||||
(require 'font-lock)
|
||||
(require 'subr-x) ;; for `when-let'
|
||||
(setq org-confirm-babel-evaluate nil)
|
||||
(global-font-lock-mode t)
|
||||
(setq org-src-fontify-natively t)
|
||||
|
||||
;(require 'ox-latex)
|
||||
;(setq org-latex-listings t)
|
||||
;(add-to-list 'org-latex-packages-alist '("" "listings"))
|
||||
;(add-to-list 'org-latex-packages-alist '("" "color"))
|
||||
|
||||
|
||||
(require 'subr-x) ;; for `when-let'
|
||||
(unless (boundp 'maximal-integer)
|
||||
(defconst maximal-integer (lsh -1 -1)
|
||||
"Maximal integer value representable natively in emacs lisp."))
|
||||
@ -65,7 +76,10 @@ with class 'color and highest min-color value."
|
||||
(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
|
||||
;;(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)
|
||||
|
||||
|
||||
|
49
tools/config_tangle.el
Executable file
49
tools/config_tangle.el
Executable file
@ -0,0 +1,49 @@
|
||||
;; Thanks to Tobias's answer on Emacs Stack Exchange:
|
||||
;; https://emacs.stackexchange.com/questions/38437/org-mode-batch-export-missing-syntax-highlighting
|
||||
|
||||
|
||||
(package-initialize)
|
||||
(add-to-list 'package-archives
|
||||
'("gnu" . "https://elpa.gnu.org/packages/"))
|
||||
(add-to-list 'package-archives
|
||||
'("melpa-stable" . "https://stable.melpa.org/packages/"))
|
||||
(add-to-list 'package-archives
|
||||
'("melpa" . "https://melpa.org/packages/"))
|
||||
(setq package-archive-priorities '(("melpa-stable" . 100)
|
||||
("melpa" . 50)
|
||||
("gnu" . 10)))
|
||||
|
||||
|
||||
(require 'font-lock)
|
||||
(setq org-confirm-babel-evaluate nil)
|
||||
(global-font-lock-mode t)
|
||||
(setq org-src-fontify-natively t)
|
||||
|
||||
(org-babel-do-load-languages
|
||||
'org-babel-load-languages
|
||||
'(
|
||||
(emacs-lisp . t)
|
||||
(shell . t)
|
||||
(python . t)
|
||||
(fortran . t)
|
||||
(C . t)
|
||||
(org . t)
|
||||
(makefile . t)
|
||||
))
|
||||
|
||||
|
||||
; The following is required to compute the file names
|
||||
(setq pwd (file-name-directory buffer-file-name))
|
||||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||||
(setq f (concat pwd name "_f.f90"))
|
||||
(setq fh_func (concat pwd name "_fh_func.f90"))
|
||||
(setq fh_type (concat pwd name "_fh_type.f90"))
|
||||
(setq c (concat pwd name ".c"))
|
||||
(setq h_func (concat name "_func.h"))
|
||||
(setq h_type (concat name "_type.h"))
|
||||
(setq h_private_type (concat name "_private_type.h"))
|
||||
(setq h_private_func (concat name "_private_func.h"))
|
||||
(setq c_test (concat pwd "test_" name ".c"))
|
||||
(setq f_test (concat pwd "test_" name "_f.f90"))
|
||||
(org-babel-lob-ingest "../tools/lib.org")
|
||||
|
139
tools/create_makefile.sh
Executable file
139
tools/create_makefile.sh
Executable file
@ -0,0 +1,139 @@
|
||||
#!/bin/bash
|
||||
# Script to generate auto-generated Makefile
|
||||
# :PROPERTIES:
|
||||
# :header-args: :tangle create_makefile.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
# :END:
|
||||
|
||||
# This script generates the Makefile that compiles the library.
|
||||
# The ~OUTPUT~ variable contains the name of the generated Makefile,typically
|
||||
# =Makefile.generated=.
|
||||
|
||||
|
||||
# This file was created by tools/Building.org
|
||||
|
||||
|
||||
|
||||
OUTPUT=Makefile.generated
|
||||
|
||||
|
||||
|
||||
# We start by tangling all the org-mode files.
|
||||
|
||||
|
||||
${QMCKL_ROOT}/tools/tangle.sh *.org
|
||||
${QMCKL_ROOT}/tools/build_qmckl_h.sh
|
||||
|
||||
|
||||
|
||||
# Then we create the list of ~*.o~ files to be created, for library
|
||||
# functions:
|
||||
|
||||
|
||||
OBJECTS="qmckl_f.o"
|
||||
for i in $(ls qmckl_*.c qmckl_*f.f90) ; do
|
||||
FILE=${i%.*}
|
||||
OBJECTS+=" ${FILE}.o"
|
||||
done >> $OUTPUT
|
||||
|
||||
|
||||
|
||||
# for tests in C:
|
||||
|
||||
|
||||
TESTS=""
|
||||
for i in $(ls test_qmckl_*.c) ; do
|
||||
FILE=${i%.c}
|
||||
TESTS+=" ${FILE}.o"
|
||||
done >> $OUTPUT
|
||||
|
||||
|
||||
|
||||
# and for tests in Fortran:
|
||||
|
||||
|
||||
TESTS_F=""
|
||||
for i in $(ls test_qmckl_*_f.f90) ; do
|
||||
FILE=${i%.f90}
|
||||
TESTS_F+=" ${FILE}.o"
|
||||
done >> $OUTPUT
|
||||
|
||||
|
||||
|
||||
# Finally, we append the rules to the Makefile
|
||||
|
||||
|
||||
cat << EOF > ${OUTPUT}
|
||||
.POSIX:
|
||||
.SUFFIXES:
|
||||
|
||||
prefix=/usr/local
|
||||
|
||||
CC=$CC
|
||||
CFLAGS=$CFLAGS -I../munit/
|
||||
|
||||
FC=$FC
|
||||
FFLAGS=$FFLAGS
|
||||
|
||||
OBJECT_FILES=$OBJECTS
|
||||
TESTS=$TESTS
|
||||
TESTS_F=$TESTS_F
|
||||
|
||||
LIBS=$LIBS
|
||||
|
||||
QMCKL_ROOT=\$(shell dirname \$(CURDIR))
|
||||
shared_lib=\$(QMCKL_ROOT)/lib/libqmckl.so
|
||||
static_lib=\$(QMCKL_ROOT)/lib/libqmckl.a
|
||||
qmckl_h=\$(QMCKL_ROOT)/include/qmckl.h
|
||||
qmckl_f=\$(QMCKL_ROOT)/share/qmckl/fortran/qmckl_f.f90
|
||||
munit=\$(QMCKL_ROOT)/munit/munit.c
|
||||
|
||||
shared: \$(shared_lib)
|
||||
static: \$(static_lib)
|
||||
all: shared static
|
||||
|
||||
\$(shared_lib): \$(OBJECT_FILES)
|
||||
\$(CC) -shared \$(OBJECT_FILES) -o \$(shared_lib)
|
||||
|
||||
\$(static_lib): \$(OBJECT_FILES)
|
||||
\$(AR) rcs \$(static_lib) \$(OBJECT_FILES)
|
||||
|
||||
|
||||
# Test
|
||||
|
||||
qmckl_f.o: \$(qmckl_f)
|
||||
\$(FC) \$(FFLAGS) -c \$(qmckl_f) -o \$@
|
||||
|
||||
test_qmckl: test_qmckl.c \$(qmckl_h) \$(static_lib) \$(TESTS) \$(TESTS_F)
|
||||
\$(CC) \$(CFLAGS) \
|
||||
\$(munit) \$(TESTS) \$(TESTS_F) \$(static_lib) \$(LIBS) test_qmckl.c -o \$@
|
||||
|
||||
test_qmckl_shared: test_qmckl.c \$(qmckl_h) \$(shared_lib) \$(TESTS) \$(TESTS_F)
|
||||
\$(CC) \$(CFLAGS) -Wl,-rpath,\$(QMCKL_ROOT)/lib -L\$(QMCKL_ROOT)/lib \
|
||||
\$(munit) \$(TESTS) \$(TESTS_F) -lqmckl \$(LIBS) test_qmckl.c -o \$@
|
||||
|
||||
check: test_qmckl test_qmckl_shared
|
||||
./test_qmckl
|
||||
|
||||
clean:
|
||||
\$(RM) -- *.o *.mod \$(shared_lib) \$(static_lib) test_qmckl
|
||||
|
||||
install:
|
||||
install -d \$(prefix)/lib
|
||||
install -d \$(prefix)/include
|
||||
install -d \$(prefix)/share/qmckl/fortran
|
||||
install -d \$(prefix)/man
|
||||
install \$(shared_lib) \$(prefix)/lib
|
||||
install \$(static_lib) \$(prefix)/lib
|
||||
install \$(qmckl_h) \$(prefix)/include
|
||||
install \$(qmckl_f) \$(prefix)/share/qmckl/fortran
|
||||
|
||||
.SUFFIXES: .c .f90 .o
|
||||
|
||||
.c.o:
|
||||
\$(CC) \$(CFLAGS) -c \$*.c -o \$*.o
|
||||
|
||||
.f90.o: qmckl_f.o
|
||||
\$(FC) \$(FFLAGS) -c \$*.f90 -o \$*.o
|
||||
|
||||
.PHONY: check clean all
|
||||
EOF
|
80
tools/init.el
Normal file
80
tools/init.el
Normal file
@ -0,0 +1,80 @@
|
||||
(package-initialize)
|
||||
(add-to-list 'package-archives
|
||||
'("gnu" . "https://elpa.gnu.org/packages/"))
|
||||
(add-to-list 'package-archives
|
||||
'("melpa-stable" . "https://stable.melpa.org/packages/"))
|
||||
(add-to-list 'package-archives
|
||||
'("melpa" . "https://melpa.org/packages/"))
|
||||
(setq package-archive-priorities '(("melpa-stable" . 100)
|
||||
("melpa" . 50)
|
||||
("gnu" . 10)))
|
||||
|
||||
(require 'cl)
|
||||
(let* ((required-packages
|
||||
'(htmlize
|
||||
evil
|
||||
org-evil
|
||||
org-bullets
|
||||
))
|
||||
(missing-packages (remove-if #'package-installed-p required-packages)))
|
||||
(when missing-packages
|
||||
(message "Missing packages: %s" missing-packages)
|
||||
(package-refresh-contents)
|
||||
(dolist (pkg missing-packages)
|
||||
(package-install pkg)
|
||||
(message "Package %s has been installed" pkg))))
|
||||
|
||||
(setq backup-directory-alist
|
||||
`(("." . ,(concat user-emacs-directory "backups"))))
|
||||
(setq backup-by-copying t)
|
||||
|
||||
(require 'org)
|
||||
(setq org-format-latex-options (plist-put org-format-latex-options :scale 1.6))
|
||||
|
||||
(setq org-hide-leading-stars t)
|
||||
(setq org-alphabetical-lists t)
|
||||
(setq org-src-fontify-natively t)
|
||||
(setq org-src-tab-acts-natively t)
|
||||
(setq org-src-preserve-indentation t)
|
||||
(setq org-hide-emphasis-markers nil)
|
||||
(setq org-pretty-entities nil)
|
||||
(setq org-confirm-babel-evaluate nil) ;; Do not ask for confirmation all the time!!
|
||||
|
||||
(org-babel-do-load-languages
|
||||
'org-babel-load-languages
|
||||
'(
|
||||
(emacs-lisp . t)
|
||||
(shell . t)
|
||||
(python . t)
|
||||
(C . t)
|
||||
(org . t)
|
||||
(makefile . t)
|
||||
))
|
||||
|
||||
(add-hook 'org-babel-after-execute-hook 'org-display-inline-images)
|
||||
'(indent-tabs-mode nil)
|
||||
|
||||
(require 'evil)
|
||||
(setq evil-want-C-i-jump nil)
|
||||
(evil-mode 1)
|
||||
(global-font-lock-mode t)
|
||||
(global-superword-mode 1)
|
||||
|
||||
(setq line-number-mode 1)
|
||||
(setq column-number-mode 1)
|
||||
|
||||
(evil-select-search-module 'evil-search-module 'evil-search)
|
||||
|
||||
(global-set-key (kbd "C-+") 'text-scale-increase)
|
||||
(global-set-key (kbd "C--") 'text-scale-decrease)
|
||||
|
||||
|
||||
(custom-set-variables
|
||||
;; custom-set-variables was added by Custom.
|
||||
;; If you edit it by hand, you could mess it up, so be careful.
|
||||
;; Your init file should contain only one such instance.
|
||||
;; If there is more than one, they won't work right.
|
||||
'(ansi-color-faces-vector
|
||||
[default default default italic underline success warning error])
|
||||
'(custom-enabled-themes (quote (leuven)))
|
||||
)
|
287
tools/lib.org
Normal file
287
tools/lib.org
Normal file
@ -0,0 +1,287 @@
|
||||
# -*- mode: org -*-
|
||||
|
||||
* Library of org-mode functions :noexport:
|
||||
** Defines the name of the current file
|
||||
|
||||
#+NAME: filename
|
||||
#+begin_src elisp :tangle no
|
||||
(file-name-nondirectory (substring buffer-file-name 0 -4))
|
||||
#+end_src
|
||||
|
||||
** Function to get the value of a property.
|
||||
#+NAME: get_value
|
||||
#+begin_src elisp :var key="Type"
|
||||
(setq x (org-property-values key))
|
||||
(pop x)
|
||||
#+end_src
|
||||
|
||||
#+RESULTS: get_value
|
||||
|
||||
** Table of function arguments
|
||||
|
||||
#+NAME: test
|
||||
| qmckl_context | context | in | Global state |
|
||||
| char | transa | in | Array ~A~ is ~'N'~: Normal, ~'T'~: Transposed |
|
||||
| char | transb | in | Array ~B~ is ~'N'~: Normal, ~'T'~: Transposed |
|
||||
| int64_t | m | in | Number of points in the first set |
|
||||
| int64_t | n | in | Number of points in the second set |
|
||||
| double | A[][lda] | in | Array containing the $m \times 3$ matrix $A$ |
|
||||
| int64_t | lda | in | Leading dimension of array ~A~ |
|
||||
| double | B[][ldb] | in | Array containing the $n \times 3$ matrix $B$ |
|
||||
| int64_t | ldb | in | Leading dimension of array ~B~ |
|
||||
| double | C[n][ldc] | out | Array containing the $m \times n$ matrix $C$ |
|
||||
| int64_t | ldc | in | Leading dimension of array ~C~ |
|
||||
|
||||
|
||||
*** Fortran-C type conversions
|
||||
|
||||
#+NAME:f_of_c
|
||||
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none"
|
||||
f_of_c_d = { '' : ''
|
||||
, 'qmckl_context' : 'integer (c_int64_t)'
|
||||
, 'qmckl_exit_code' : 'integer (c_int32_t)'
|
||||
, 'int32_t' : 'integer (c_int32_t)'
|
||||
, 'int64_t' : 'integer (c_int64_t)'
|
||||
, 'float' : 'real (c_float )'
|
||||
, 'double' : 'real (c_double )'
|
||||
, 'char' : 'character'
|
||||
}
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: f_of_c
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
None
|
||||
#+end_src
|
||||
|
||||
#+NAME:c_of_f
|
||||
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none"
|
||||
ctypeid_d = { '' : ''
|
||||
, 'qmckl_context' : 'integer(c_int64_t)'
|
||||
, 'qmckl_exit_code' : 'integer(c_int32_t)'
|
||||
, 'integer' : 'integer(c_int32_t)'
|
||||
, 'integer*8' : 'integer(c_int64_t)'
|
||||
, 'real' : 'real(c_float)'
|
||||
, 'real*8' : 'real(c_double)'
|
||||
, 'character' : 'character(c_char)'
|
||||
}
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: c_of_f
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
None
|
||||
#+end_src
|
||||
|
||||
*** Parse the table
|
||||
|
||||
#+NAME: parse_table
|
||||
#+BEGIN_SRC python :results none :noweb yes :exports none
|
||||
def parse_table(table):
|
||||
result = []
|
||||
|
||||
for line in table:
|
||||
d = { "c_type" : line[0],
|
||||
"inout" : line[2].lower(),
|
||||
"name" : line[1],
|
||||
"comment" : line[3] }
|
||||
|
||||
# Handle inout
|
||||
if d["inout"] in ["input", "in"]:
|
||||
d["inout"] == "in"
|
||||
elif d["inout"] in ["output", "out"]:
|
||||
d["inout"] == "out"
|
||||
elif d["inout"] in ["input/output", "inout"]:
|
||||
d["inout"] == "inout"
|
||||
|
||||
# Find dimensions (replace [] by [*] to get * in Fortran dimensions)
|
||||
dims = d["name"].replace("[]","[*]").split('[')
|
||||
d["rank"] = len(dims) - 1
|
||||
if d["rank"] == 0:
|
||||
d["dims"] = []
|
||||
else:
|
||||
d["name"] = d["name"].split('[')[0].strip()
|
||||
d["dims"] = [ x.replace(']','').strip() for x in dims[1:] ]
|
||||
|
||||
result.append(d)
|
||||
|
||||
return result
|
||||
#+END_SRC
|
||||
|
||||
*** Generates a C header
|
||||
|
||||
#+NAME: generate_c_header
|
||||
#+BEGIN_SRC python :var table=[] :var rettyp=[] :var fname=[] :results drawer :noweb yes :wrap "src c :tangle (eval h_func) :comments org"
|
||||
<<parse_table>>
|
||||
|
||||
results = []
|
||||
for d in parse_table(table):
|
||||
name = d["name"]
|
||||
c_type = d["c_type"]
|
||||
|
||||
# Add star for arrays
|
||||
if d["rank"] > 0 or d["inout"] in ["out", "inout"]:
|
||||
c_type += "*"
|
||||
|
||||
if d["inout"] == "out":
|
||||
c_type += " const"
|
||||
|
||||
# Only inputs are const
|
||||
if d["inout"] == "in":
|
||||
const = "const "
|
||||
else:
|
||||
const = ""
|
||||
|
||||
results += [ f" {const}{c_type} {name}" ]
|
||||
|
||||
results=',\n'.join(results)
|
||||
template = f"""{rettyp} {fname} (
|
||||
{results} ); """
|
||||
return template
|
||||
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: generate_c_header
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
[] [] (
|
||||
const qmckl_context context,
|
||||
const char transa,
|
||||
const char transb,
|
||||
const int64_t m,
|
||||
const int64_t n,
|
||||
const double* const A,
|
||||
const int64_t lda,
|
||||
const double* const B,
|
||||
const int64_t ldb,
|
||||
double* const C,
|
||||
const int64_t ldc );
|
||||
#+end_src
|
||||
|
||||
*** Generates a C interface to the Fortran function
|
||||
|
||||
#+NAME: generate_c_interface
|
||||
#+BEGIN_SRC python :var table=[] :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval f) :comments org :exports none"
|
||||
<<c_of_f>>
|
||||
<<f_of_c>>
|
||||
<<parse_table>>
|
||||
d = parse_table(table)
|
||||
|
||||
args = ", ".join([ x["name"] for x in d ])
|
||||
|
||||
rettyp_c = ctypeid_d[rettyp.lower()]
|
||||
|
||||
results = [ f"{rettyp_c} function {fname} &"
|
||||
, f" ({args}) &"
|
||||
, " bind(C) result(info)"
|
||||
, ""
|
||||
, " use, intrinsic :: iso_c_binding"
|
||||
, " implicit none"
|
||||
, ""
|
||||
]
|
||||
|
||||
for d in parse_table(table):
|
||||
f_type = f_of_c_d[d["c_type"]]
|
||||
inout = "intent("+d["inout"]+")"
|
||||
name = d["name"]
|
||||
|
||||
# Input scalars are passed by value
|
||||
if d["rank"] == 0 and d["inout"] == "in":
|
||||
value = ", value"
|
||||
else:
|
||||
value = " "
|
||||
|
||||
# Append dimensions to the name
|
||||
if d["rank"] == 0:
|
||||
dims = ""
|
||||
else:
|
||||
d["dims"].reverse()
|
||||
dims = "(" + ",".join(d["dims"]) + ")"
|
||||
|
||||
results += [ f" {f_type:20}, {inout:12}{value} :: {name}{dims}" ]
|
||||
|
||||
results += [ ""
|
||||
, f" {rettyp_c}, external :: {fname}_f"
|
||||
, f" info = {fname}_f &"
|
||||
, f" ({args})"
|
||||
, ""
|
||||
, f"end function {fname}"
|
||||
]
|
||||
results='\n'.join(results)
|
||||
return results
|
||||
#+END_SRC
|
||||
|
||||
*** Generates a Fortran interface to the C function
|
||||
|
||||
#+NAME: generate_f_interface
|
||||
#+BEGIN_SRC python :var table=test :var rettyp="integer" :var fname=[] :results value :noweb yes :wrap "src f90 :tangle (eval fh_func) :comments org :exports none"
|
||||
<<c_of_f>>
|
||||
<<f_of_c>>
|
||||
<<parse_table>>
|
||||
d = parse_table(table)
|
||||
|
||||
args = ", ".join([ x["name"] for x in d ])
|
||||
|
||||
rettyp_c = ctypeid_d[rettyp.lower()]
|
||||
|
||||
results = [ f"interface"
|
||||
, f" {rettyp_c} function {fname} &"
|
||||
, f" ({args}) &"
|
||||
, " bind(C)"
|
||||
, " use, intrinsic :: iso_c_binding"
|
||||
, " import"
|
||||
, " implicit none"
|
||||
, ""
|
||||
]
|
||||
|
||||
for d in parse_table(table):
|
||||
f_type = f_of_c_d[d["c_type"]]
|
||||
inout = "intent("+d["inout"]+")"
|
||||
name = d["name"]
|
||||
|
||||
# Input scalars are passed by value
|
||||
if d["rank"] == 0 and d["inout"] == "in":
|
||||
value = ", value"
|
||||
else:
|
||||
value = " "
|
||||
|
||||
# Append dimensions to the name
|
||||
if d["rank"] == 0:
|
||||
dims = ""
|
||||
else:
|
||||
d["dims"].reverse()
|
||||
dims = "(" + ",".join(d["dims"]) + ")"
|
||||
|
||||
results += [ f" {f_type:20}, {inout:12}{value} :: {name}{dims}" ]
|
||||
|
||||
results += [ ""
|
||||
, f" end function {fname}"
|
||||
, f"end interface"
|
||||
]
|
||||
results='\n'.join(results)
|
||||
return results
|
||||
#+END_SRC
|
||||
|
||||
#+RESULTS: generate_f_interface
|
||||
#+begin_src f90 :tangle (eval fh_func) :comments org :exports none
|
||||
interface
|
||||
integer(c_int32_t) function [] &
|
||||
(context, transa, transb, m, n, A, lda, B, ldb, C, ldc) &
|
||||
bind(C)
|
||||
use, intrinsic :: iso_c_binding
|
||||
import
|
||||
implicit none
|
||||
|
||||
integer (qmckl_context), intent(in) , value :: context
|
||||
character , intent(in) , value :: transa
|
||||
character , intent(in) , value :: transb
|
||||
integer (c_int64_t) , intent(in) , value :: m
|
||||
integer (c_int64_t) , intent(in) , value :: n
|
||||
real (c_double ) , intent(in) :: A(lda,3)
|
||||
integer (c_int64_t) , intent(in) , value :: lda
|
||||
real (c_double ) , intent(in) :: B(ldb,3)
|
||||
integer (c_int64_t) , intent(in) , value :: ldb
|
||||
real (c_double ) , intent(out) :: C(ldc,n)
|
||||
integer (c_int64_t) , intent(in) , value :: ldc
|
||||
|
||||
end function []
|
||||
end interface
|
||||
#+end_src
|
||||
|
8
tools/merge_org.sh
Executable file
8
tools/merge_org.sh
Executable file
@ -0,0 +1,8 @@
|
||||
#!/bin/bash
|
||||
|
||||
OUTPUT=$1
|
||||
|
||||
for i in README.org $(cat $QMCKL_ROOT/src/table_of_contents)
|
||||
do
|
||||
cat $i >> $1
|
||||
done
|
11
tools/nb_to_org.sh
Executable file
11
tools/nb_to_org.sh
Executable file
@ -0,0 +1,11 @@
|
||||
#!/bin/bash
|
||||
# $ nb_to_org.sh notebook.ipynb
|
||||
# produces the org-mode file notebook.org
|
||||
|
||||
set -e
|
||||
|
||||
nb=$(basename $1 .ipynb)
|
||||
jupyter nbconvert --to markdown ${nb}.ipynb --output ${nb}.md
|
||||
pandoc ${nb}.md -o ${nb}.org
|
||||
rm ${nb}.md
|
||||
|
44
tools/rename.py
Executable file
44
tools/rename.py
Executable file
@ -0,0 +1,44 @@
|
||||
#!/usr/bin/env python
|
||||
|
||||
"""
|
||||
Changes the name of a function into all the org files.
|
||||
This script should be run in the src directory.
|
||||
"""
|
||||
|
||||
import sys
|
||||
import os
|
||||
|
||||
|
||||
def help():
|
||||
print("Syntax : {0} OLD_FUNC_NAME NEW_FUNC_NAME".format(sys.argv[0]))
|
||||
|
||||
|
||||
|
||||
def replace_in_file(filename, old_func_name, new_func_name):
|
||||
with open(filename,'r') as f:
|
||||
text = f.read()
|
||||
|
||||
new_text = text.replace(old_func_name, new_func_name)
|
||||
|
||||
with open(filename,'w') as f:
|
||||
f.write(new_text)
|
||||
|
||||
|
||||
def main():
|
||||
if len(sys.argv) != 3:
|
||||
help()
|
||||
sys.exit(-1)
|
||||
old_func_name = sys.argv[1]
|
||||
new_func_name = sys.argv[2]
|
||||
|
||||
for filename in os.listdir(os.getcwd()):
|
||||
if filename.endswith(".org"):
|
||||
replace_in_file(filename, old_func_name, new_func_name)
|
||||
|
||||
print("Done. run git diff to check what has been changed.")
|
||||
|
||||
|
||||
|
||||
|
||||
if __name__ == "__main__":
|
||||
main()
|
41
tools/tangle.sh
Executable file
41
tools/tangle.sh
Executable file
@ -0,0 +1,41 @@
|
||||
#!/bin/bash
|
||||
# Script to tangle the org-mode files
|
||||
# :PROPERTIES:
|
||||
# :header-args: :tangle tangle.sh :noweb yes :shebang #!/bin/bash :comments org
|
||||
# :END:
|
||||
|
||||
|
||||
# This file was created by tools/Building.org
|
||||
|
||||
|
||||
|
||||
# This file needs to be run from the QMCKL =src= directory.
|
||||
|
||||
# It tangles all the files in the directory. It uses the
|
||||
# =config_tangle.el= file, which contains information required to
|
||||
# compute the current file names using for example ~(eval c)~ to get
|
||||
# the name of the produced C file.
|
||||
|
||||
# The file is not tangled if the last modification date of the org
|
||||
# file is less recent than one of the tangled files.
|
||||
|
||||
|
||||
function tangle()
|
||||
{
|
||||
local org_file=$1
|
||||
local c_file=${org_file%.org}.c
|
||||
local f_file=${org_file%.org}.f90
|
||||
|
||||
if [[ ${org_file} -ot ${c_file} ]] ; then
|
||||
return
|
||||
elif [[ ${org_file} -ot ${f_file} ]] ; then
|
||||
return
|
||||
fi
|
||||
emacs --batch ${org_file} --load=../tools/config_tangle.el -f org-babel-tangle
|
||||
}
|
||||
|
||||
for i in $@
|
||||
do
|
||||
echo "--- ${i} ----"
|
||||
tangle ${i}
|
||||
done
|
Loading…
Reference in New Issue
Block a user