TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-07-18 17:03:43 +02:00
Code Issues Projects Releases Wiki Activity

Merge pull request #4 from TREX-CoE/master

Browse Source 
Merge with main repo.
This commit is contained in:
vijay 2021-04-29 07:48:50 +02:00 committed by GitHub
commit afed24ff40
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
44 changed files with 7645 additions and 1716 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
.github/workflows/gh-pages.yml vendored
View File

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

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

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

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

@ -0,0 +1 @@
*.txt

1
docs/org-html-themes Submodule

@ -0,0 +1 @@
Subproject commit f7224a489462abc2c2174edbf7d4e82c0e276183

972
docs/qmckl.css Normal file
View 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
View 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
View File

@ -0,0 +1 @@

2
lib/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
libqmckl.so
libqmckl.a

0
man/.gitignore vendored Normal file
View File

1
share/qmckl/fortran/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
qmckl_f.f90

125
src/Makefile
View File

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

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

13
src/create_doc.sh
View File

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

95
src/create_makefile.sh
View File

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

13
src/merge_org.sh
View File

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

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

File diff suppressed because it is too large Load Diff

1079
src/qmckl_context.org
View File

File diff suppressed because it is too large Load Diff

683
src/qmckl_distance.org
View File

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

18
src/qmckl_footer.org
View File

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

329
src/qmckl_memory.org
View File

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

101
src/test_qmckl.org
View File

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

18
docs/config.el → tools/config_doc.el
View File

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