diff --git a/docs/qmckl.css b/docs/qmckl.css new file mode 100644 index 0000000..cfc7a63 --- /dev/null +++ b/docs/qmckl.css @@ -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 */ diff --git a/docs/theme.setup b/docs/theme.setup index c56aee9..da0d396 100644 --- a/docs/theme.setup +++ b/docs/theme.setup @@ -1,7 +1,15 @@ # -*- 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 -#+SETUPFILE: ../docs/org-html-themes/org/theme-readtheorg.setup +#+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: + +#+STARTUP: align fold nodlcheck hidestars oddeven lognotestate +#+AUTHOR: TREX CoE +#+LANGUAGE: en diff --git a/src/Makefile b/src/Makefile index 90ee33a..042c095 100644 --- a/src/Makefile +++ b/src/Makefile @@ -3,6 +3,11 @@ # This file was created by tools/Building.org +# Dependencies + + +LIBS=-lpthread + # Variables @@ -39,7 +44,7 @@ FFLAGS=-fPIC $(INCLUDE) \ -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ -ffpe-trap=zero,overflow,underflow -LIBS=-lgfortran -lm +LIBS+=-lgfortran -lm #---------------------------------------------------------- endif @@ -54,7 +59,7 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=ifort -xHost FFLAGS=-fPIC -g -O2 $(INCLUDE) -LIBS=-lm -lifcore -lirc +LIBS+=-lm -lifcore -lirc #---------------------------------------------------------- CC=icc -xHost endif @@ -70,12 +75,14 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=flang FFLAGS=fPIC -g -O2 $(INCLUDE) -LIBS=-lm +LIBS+=-lm #---------------------------------------------------------- endif # Rules +# The source files are created during the generation of the file ~Makefile.generated~. + .PHONY: clean .SECONDARY: # Needed to keep the produced C and Fortran files @@ -83,14 +90,17 @@ endif libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated -test: Makefile.generated +../include/qmckl.h: libqmckl.so + ../tools/build_qmckl_h.sh + +test: Makefile.generated ../include/qmckl.h $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_doc.sh clean: - $(RM) qmckl.h test_qmckl_* test_qmckl.c test_qmckl \ + $(RM) test_qmckl_* test_qmckl.c test_qmckl \ qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ Makefile.generated libqmckl.so *.html *.mod diff --git a/src/README.org b/src/README.org index d09949d..86e2908 100644 --- a/src/README.org +++ b/src/README.org @@ -1,246 +1,68 @@ #+TITLE: QMCkl source code documentation -#+EXPORT_FILE_NAME: index.html #+PROPERTY: comments org #+SETUPFILE: ../docs/theme.setup +------------------ -* Introduction + #+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 - 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. + 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. + 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. -** Literate programming +------------------ - 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. - - 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. - - 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. - - 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. - - -** Source code editing - - For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. - - 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 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=. Fortran interfaces 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, 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 ~~ 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 =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 - - # The .org files will be appended here in the order specified in the - # table_of_contents file + [[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 -*- + diff --git a/src/qmckl.org b/src/qmckl.org index b9a736f..ff58ace 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -1,19 +1,253 @@ -#+TITLE: Header files +#+TITLE: Introduction +#+PROPERTY: comments org #+SETUPFILE: ../docs/theme.setup +# -*- mode: org -*- + +* Using QMCkl -The =qmckl.h= header file has to be included in <<>> codes when +The =qmckl.h= header file has to be included in C codes when QMCkl functions are used: -#+begin_src c :tangle none +#+begin_src c :tangle no #include "qmckl.h" -#+end_src f90 +#+end_src - -In <<>> programs, the =qmckl_f.f90= interface file should be +In Fortran programs, the =qmckl_f.f90= interface file should be included in the source code using the library, and the Fortran codes should use the ~qmckl~ module as -#+begin_src f90 :tangle none +#+begin_src f90 :tangle no use qmckl -#+end_src f90 +#+end_src + +Both files are located in the =include/= directory. + +* Developing in QMCkl + +** Literate programming + + 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. + + 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. + + 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. + + 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. + + +** Source code editing + + For a tutorial on literate programming with org-mode, follow [[http://www.howardism.org/Technical/Emacs/literate-programming-tutorial.html][this link]]. + + 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=. Fortran interfaces 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, 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 ~~ 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_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 + + + + diff --git a/src/qmckl_context.org b/src/qmckl_context.org index 6edfe2c..8a68835 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -1,20 +1,24 @@ #+TITLE: Context #+SETUPFILE: ../docs/theme.setup - This file is written in C because it is more natural to express the - context in C than in Fortran. The context variable is a handle for the state of the library, - and is stored in a data structure, which can't be seen outside of + and is stored in a data structure which can't be seen outside of the library. To simplify compatibility with other languages, the pointer to the internal data structure is converted into a 64-bit - signed integer, defined in the ~qmckl_context~ type. A value of ~0~ - for the context is equivalent to a ~NULL~ pointer. + signed integer, defined in the ~qmckl_context~ type. + A value of ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a + ~NULL~ pointer. #+begin_src c :comments org :tangle (eval h) typedef int64_t qmckl_context ; +#define QMCKL_NULL_CONTEXT (qmckl_context) 0 #+end_src + #+begin_src f90 :comments org :tangle (eval fh) :exports none + integer*8, parameter :: QMCKL_NULL_CONTEXT = 0 + #+end_src + * Headers :noexport: #+NAME: filename @@ -34,6 +38,7 @@ MunitResult test_<>() { #define __QMCKL_CONTEXT__ #include +#include #include "qmckl_error.h" #+end_src @@ -46,191 +51,352 @@ MunitResult test_<>() { #include #include "qmckl_error.h" -#include "qmckl_context_private.h" #include "qmckl_context.h" +#include "qmckl_context_private.h" #include "qmckl_memory.h" -#include "qmckl_precision.h" #+end_src - * Context handling - The tag is used internally to check if the memory domain pointed - by a pointer is a valid <<>>. + The context appears as an immutable data structure: modifying a + context returns a new context with the modifications. Therefore, it + is necessary to store a pointer to the old version of context so + that it can be freed when necessary. + Note that we also provide a possibility to mutate the context, but + this should be done with caution, only when it is justified. - #+begin_src c :comments org :tangle (eval h_private) :noweb yes -<> -<> + By convention, in this file ~context~ is a ~qmckl_context~ variable + and ~ctx~ is a ~qmckl_context_struct*~ pointer. +** Data structure + + The main data structure contains pointers to other data structures, + containing the data specific to each given domain, such that the + modified contexts don't need to duplicate the data but only the + pointers. + + #+NAME: qmckl_context_struct + #+begin_src c :comments org :tangle none :noweb yes typedef struct qmckl_context_struct { + /* Pointer to the previous context, before modification */ struct qmckl_context_struct * prev; /* Molecular system */ - // qmckl_nucleus_struct * nucleus; - // qmckl_electron_struct * electron; - qmckl_ao_basis_struct * ao_basis; - // qmckl_mo_struct * mo; - // qmckl_determinant_struct * det; + qmckl_ao_basis_struct * ao_basis; + + /* To be implemented: + qmckl_nucleus_struct * nucleus; + qmckl_electron_struct * electron; + qmckl_mo_struct * mo; + qmckl_determinant_struct * det; + ,*/ /* Numerical precision */ - uint32_t tag; - int32_t precision; - int32_t range; + qmckl_precision_struct * fp; /* Error handling */ - qmckl_error_struct * error; + qmckl_error_struct * error; + + /* Memory allocation */ + qmckl_memory_struct * alloc; + + /* Thread lock */ + pthread_mutex_t mutex; + + /* Validity checking */ + uint32_t tag; } qmckl_context_struct; + #+end_src + + #+begin_src c :comments org :tangle (eval h_private) :noweb yes :exports none +<> + +<> + +<> + +<> + +<> + #+end_src + + A tag is used internally to check if the memory domain pointed + by a pointer is a valid context. This allows to check that even if + the pointer associated with a context is non-null, we can still + verify that it points to the expected data structure. + + #+begin_src c :comments org :tangle (eval h_private) :noweb yes #define VALID_TAG 0xBEEFFACE #define INVALID_TAG 0xDEADBEEF - #+end_src + #+end_src -** ~qmckl_context_check~ + The ~qmckl_context_check~ function checks if the domain pointed by + the pointer is a valid context. It returns the input ~qmckl_context~ + if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise. - Checks if the domain pointed by the pointer is a valid context. - Returns the input ~qmckl_context~ if the context is valid, 0 - otherwise. - - #+begin_src c :comments org :tangle (eval h) + #+begin_src c :comments org :tangle (eval h) :noexport qmckl_context qmckl_context_check(const qmckl_context context) ; #+end_src -*** Source - #+begin_src c :tangle (eval c) + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_check(const qmckl_context context) { - if (context == (qmckl_context) 0) return (qmckl_context) 0; + if (context == QMCKL_NULL_CONTEXT) + return QMCKL_NULL_CONTEXT; - const qmckl_context_struct * ctx = (qmckl_context_struct*) context; + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx->tag != VALID_TAG) return (qmckl_context) 0; + if (ctx->tag != VALID_TAG) + return QMCKL_NULL_CONTEXT; return context; } - #+end_src + #+end_src -** ~qmckl_context_create~ +** Creation + + To create a new context, ~qmckl_context_create()~ should be used. + - Upon success, it returns a pointer to a new context with the ~qmckl_context~ type + - It returns ~QMCKL_NULL_CONTEXT~ upon failure to allocate the internal data structure - To create a new context, use ~qmckl_context_create()~. - - On success, returns a pointer to a context using the ~qmckl_context~ type - - Returns ~0~ upon failure to allocate the internal data structure - - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context qmckl_context_create(); - #+end_src + #+end_src -*** Source - #+begin_src c :tangle (eval c) + # Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_create() { - qmckl_context_struct* context = - (qmckl_context_struct*) qmckl_malloc ((qmckl_context) 0, sizeof(qmckl_context_struct)); - if (context == NULL) { - return (qmckl_context) 0; + qmckl_context_struct* ctx = + (qmckl_context_struct*) qmckl_malloc (QMCKL_NULL_CONTEXT, sizeof(qmckl_context_struct)); + + if (ctx == NULL) { + return QMCKL_NULL_CONTEXT; } - context->prev = NULL; - context->ao_basis = NULL; - context->precision = QMCKL_DEFAULT_PRECISION; - context->range = QMCKL_DEFAULT_RANGE; - context->tag = VALID_TAG; - context->error = NULL; + /* Set all pointers to NULL */ + memset(ctx, 0, sizeof(qmckl_context_struct)); - return (qmckl_context) context; + /* Initialize lock */ + pthread_mutexattr_t attr; + int rc; + + rc = pthread_mutexattr_init(&attr); + assert (rc == 0); + + (void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_ERRORCHECK); + + rc = pthread_mutex_init ( &(ctx->mutex), &attr); + assert (rc == 0); + + (void)pthread_mutexattr_destroy(&attr); + + /* Initialize data */ + ctx->tag = VALID_TAG; + + const qmckl_context context = (qmckl_context) ctx; + assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT ); + + return context; } - #+end_src + #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none interface integer (c_int64_t) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding end function qmckl_context_create end interface - #+end_src + #+end_src + + # Test + #+begin_src c :comments link :tangle (eval c_test) :exports none +munit_assert_int64( qmckl_context_check(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64( qmckl_context_check(0x12345), ==, QMCKL_NULL_CONTEXT); -*** Test :noexport: - #+begin_src c :comments link :tangle (eval c_test) qmckl_context context = qmckl_context_create(); -munit_assert_int64( context, !=, (qmckl_context) 0); -munit_assert_int64( qmckl_context_check(context), ==, context); - #+end_src +munit_assert_int64( context, !=, QMCKL_NULL_CONTEXT ); +munit_assert_int64( qmckl_context_check(context), ==, context ); + #+end_src -** ~qmckl_context_copy~ +** Locking - This function makes a shallow copy of the current context. - - Copying the 0-valued context returns 0 - - On success, returns a pointer to the new context using the ~qmckl_context~ type - - Returns 0 upon failure to allocate the internal data structure - for the new context + For thread safety, the context may be locked/unlocked. The lock is + initialized with the ~PTHREAD_MUTEX_ERRORCHECK~, so it is a bit + slower than a usual mutex but safer. - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +void qmckl_lock (qmckl_context context); +void qmckl_unlock(qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +void qmckl_lock(qmckl_context context) { + if (context == QMCKL_NULL_CONTEXT) + return ; + qmckl_context_struct *ctx = (qmckl_context_struct*) context; + int rc = pthread_mutex_lock( &(ctx->mutex) ); + assert (rc == 0); +} + +void qmckl_unlock(qmckl_context context) { + qmckl_context_struct *ctx = (qmckl_context_struct*) context; + int rc = pthread_mutex_unlock( &(ctx->mutex) ); + assert (rc == 0); +} + #+end_src + +** Copy + + ~qmckl_context_copy~ makes a shallow copy of a context. It returns + ~QMCKL_NULL_CONTEXT~ upon failure. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context qmckl_context_copy(const qmckl_context context); - #+end_src + #+end_src -*** Source - #+begin_src c :tangle (eval c) + # Source + #+begin_src c :tangle (eval c) qmckl_context qmckl_context_copy(const qmckl_context context) { + qmckl_lock(context); + const qmckl_context checked_context = qmckl_context_check(context); - if (checked_context == (qmckl_context) 0) { - return (qmckl_context) 0; + if (checked_context == QMCKL_NULL_CONTEXT) { + qmckl_unlock(context); + return QMCKL_NULL_CONTEXT; } - qmckl_context_struct* old_context = (qmckl_context_struct*) checked_context; + + qmckl_context_struct* old_ctx = + (qmckl_context_struct*) checked_context; - qmckl_context_struct* new_context = + qmckl_context_struct* new_ctx = (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); - if (new_context == NULL) { - return (qmckl_context) 0; + + if (new_ctx == NULL) { + qmckl_unlock(context); + return QMCKL_NULL_CONTEXT; } - new_context->prev = old_context; - new_context->ao_basis = old_context->ao_basis; - new_context->precision = old_context->precision; - new_context->range = old_context->range; - new_context->tag = VALID_TAG; - new_context->error = old_context->error; + /* Copy the old context on the new one */ + memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct)); - return (qmckl_context) new_context; + qmckl_unlock(context); + + new_ctx->prev = old_ctx; + + return (qmckl_context) new_ctx; } - #+end_src + #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none interface integer (c_int64_t) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_copy end interface - #+end_src + #+end_src -*** Test :noexport: - #+begin_src c :comments link :tangle (eval c_test) + # Test + #+begin_src c :comments link :tangle (eval c_test) :exports none qmckl_context new_context = qmckl_context_copy(context); -munit_assert_int64(new_context, !=, (qmckl_context) 0); + +munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); + #+end_src + +** Destroy + + The context is destroyed with ~qmckl_context_destroy~, leaving the ancestors untouched. + It frees the context, and returns the previous context. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_context qmckl_context_destroy(qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_context qmckl_context_destroy(const qmckl_context context) { + + qmckl_lock(context); + + const qmckl_context checked_context = qmckl_context_check(context); + if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_NULL_CONTEXT; + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + assert (ctx != NULL); /* Shouldn't be true because the context is valid */ + + const qmckl_context prev_context = (qmckl_context) ctx->prev; + memset(ctx, 0, sizeof(qmckl_context_struct)); + ctx->tag = INVALID_TAG; + + const qmckl_exit_code rc = qmckl_free(context,ctx); + assert (rc == QMCKL_SUCCESS); + + if (prev_context == QMCKL_NULL_CONTEXT) { + /* This is the first context, free all memory. */ + while (ctx->alloc != NULL) { + free(ctx->alloc->pointer); + ctx->alloc = ctx->alloc->prev; + } + int rc = pthread_mutex_destroy( &(ctx->mutex) ); + assert (rc == 0); + } + + qmckl_unlock(context); + + return prev_context; +} #+end_src -** ~qmckl_context_previous~ + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int64_t) function qmckl_context_destroy(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_destroy + end interface + #+end_src - Returns the previous context - - On success, returns the ancestor of the current context - - Returns 0 for the initial context - - Returns 0 for the 0-valued context + # Test + #+begin_src c :tangle (eval c_test) :exports none +munit_assert_int64(qmckl_context_check(new_context), ==, new_context); +munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_destroy(new_context), ==, context); +munit_assert_int64(qmckl_context_check(new_context), !=, new_context); +munit_assert_int64(qmckl_context_check(new_context), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_destroy(context), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_destroy(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); + #+end_src - #+begin_src c :comments org :tangle (eval h) +** Access to the previous context + + ~qmckl_context_previous~ returns the previous context. It returns + ~QMCKL_NULL_CONTEXT~ for the initial context and for the ~NULL~ context. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context qmckl_context_previous(const qmckl_context context); - #+end_src + #+end_src -*** Source + # Source #+begin_src c :tangle (eval c) qmckl_context qmckl_context_previous(const qmckl_context context) { @@ -244,8 +410,8 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { } #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none interface integer (c_int64_t) function qmckl_context_previous(context) bind(C) use, intrinsic :: iso_c_binding @@ -254,67 +420,154 @@ qmckl_context qmckl_context_previous(const qmckl_context context) { end interface #+end_src -*** Test :noexport: - #+begin_src c :comments link :tangle (eval c_test) -munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); + # Test + #+begin_src c :comments link :tangle (eval c_test) :exports none +munit_assert_int64(qmckl_context_previous(new_context), !=, QMCKL_NULL_CONTEXT); munit_assert_int64(qmckl_context_previous(new_context), ==, context); -munit_assert_int64(qmckl_context_previous(context), ==, (qmckl_context) 0); -munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); +munit_assert_int64(qmckl_context_previous(context), ==, QMCKL_NULL_CONTEXT); +munit_assert_int64(qmckl_context_previous(QMCKL_NULL_CONTEXT), ==, QMCKL_NULL_CONTEXT); #+end_src -** ~qmckl_context_destroy~ +* Memory allocation handling + +** Data structure - Destroys the current context, leaving the ancestors untouched. - - Succeeds if the current context is properly destroyed - - Fails otherwise - - Fails if the 0-valued context is given in argument - - Fails if the the pointer is not a valid context - - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code qmckl_context_destroy(qmckl_context context); + Pointers to all allocated memory domains are stored in the context, + in a linked list. The size is also stored, to enable the + computation of the amount of currently used memory by the library. + + #+NAME: qmckl_memory_struct + #+begin_src c :comments org :tangle no +typedef struct qmckl_memory_struct { + struct qmckl_memory_struct * prev ; + void * pointer ; + size_t size ; +} qmckl_memory_struct; #+end_src -*** Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { +** Append memory - const qmckl_context checked_context = qmckl_context_check(context); - if (checked_context == (qmckl_context) 0) return QMCKL_FAILURE; + The following function, called in [[./qmckl_memory.html][=qmckl_memory.c=]], appends a new + pair (pointer, size) to the data structure. + It is forbidden to pass the ~NULL~ pointer, or a zero size. + If the context is ~QMCKL_NULL_CONTEXT~, the function returns + immediately with ~QMCKL_SUCCESS~. - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; + # Header + #+begin_src c :comments org :tangle (eval h_private) :exports none +qmckl_exit_code qmckl_context_append_memory(qmckl_context context, + void* pointer, + const size_t size); + #+end_src + + # Source + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_context_append_memory(qmckl_context context, + void* pointer, + const size_t size) { + assert (pointer != NULL); + assert (size > 0L); + + qmckl_lock(context); + + if ( qmckl_context_check(context) == QMCKL_NULL_CONTEXT ) { + qmckl_unlock(context); + return QMCKL_SUCCESS; + } + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + + qmckl_memory_struct* alloc = (qmckl_memory_struct*) + malloc(sizeof(qmckl_memory_struct)); + + if (alloc == NULL) { + qmckl_unlock(context); + return QMCKL_ALLOCATION_FAILED; + } + + alloc->prev = ctx->alloc; + alloc->pointer = pointer; + alloc->size = size; + + ctx->alloc = alloc; + + qmckl_unlock(context); + + return QMCKL_SUCCESS; - ctx->tag = INVALID_TAG; - return qmckl_free(context,ctx); } - #+end_src + #+end_src -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_destroy(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_destroy - end interface - #+end_src +** Remove memory + + The following function, called in [[./qmckl_memory.html][=qmckl_memory.c=]], removes a + pointer from the data structure. + It is forbidden to pass the ~NULL~ pointer. + If the context is ~QMCKL_NULL_CONTEXT~, the function returns + immediately with ~QMCKL_SUCCESS~. -*** Test :noexport: - #+begin_src c :tangle (eval c_test) -munit_assert_int64(qmckl_context_check(new_context), ==, new_context); -munit_assert_int64(new_context, !=, (qmckl_context) 0); -munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); -munit_assert_int64(qmckl_context_check(new_context), !=, new_context); -munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); -munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); - #+end_src + # Header + #+begin_src c :comments org :tangle (eval h_private) :exports none +qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, + const void* pointer); + #+end_src + # Source + #+begin_src c :comments org :tangle (eval c) +qmckl_exit_code qmckl_context_remove_memory(qmckl_context context, + const void* pointer) { + assert (pointer != NULL); + + qmckl_lock(context); + + if ( qmckl_context_check(context) == QMCKL_NULL_CONTEXT ) { + qmckl_unlock(context); + return QMCKL_SUCCESS; + } + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + + qmckl_memory_struct* alloc; + qmckl_memory_struct* next; + + if (ctx->alloc->pointer == pointer) { + + alloc = ctx->alloc->prev; + free(ctx->alloc); + ctx->alloc = alloc; + + } else { + + next = ctx->alloc; + alloc = next->prev; + + while (alloc != NULL) { + if (alloc->pointer == pointer) { + next->prev = alloc->prev; + free(alloc); + alloc = NULL; + } else { + next = alloc; + alloc = alloc->prev; + } + } + } + + qmckl_unlock(context); + + return QMCKL_SUCCESS; +} + #+end_src + + #+RESULTS: + * Error handling + ** Data structure #+NAME: qmckl_error_struct - #+begin_src c :comments org -#define QMCKL_MAX_FUN_LEN 256 + #+begin_src c :comments org :tangle no +#define QMCKL_MAX_FUN_LEN 256 #define QMCKL_MAX_MSG_LEN 1024 typedef struct qmckl_error_struct { @@ -326,68 +579,110 @@ typedef struct qmckl_error_struct { } qmckl_error_struct; #+end_src -** ~qmckl_context_update_error~ +** Updating errors + + The error is updated in the context using + ~qmckl_context_update_error~, although it is recommended to use + ~qmckl_context_set_error~ for the immutable variant. + 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~. - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_exit_code -qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); +qmckl_context_update_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) + # Source + #+begin_src c :tangle (eval c) qmckl_exit_code -qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +qmckl_context_update_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message) { - assert (context != 0); - assert (function != NULL); + /* Passing a function name and a message is mandatory. */ + assert (function_name != NULL); assert (message != NULL); - assert (exit_code > 0); + + /* Exit codes are assumed valid. */ + assert (exit_code >= 0); + assert (exit_code != QMCKL_SUCCESS); assert (exit_code < QMCKL_INVALID_EXIT_CODE); + qmckl_lock(context); + + /* The context is assumed to exist. */ + assert (qmckl_context_check(context) != QMCKL_NULL_CONTEXT); + qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; + assert (ctx != NULL); /* Impossible because the context is valid. */ if (ctx->error != NULL) { free(ctx->error); ctx->error = NULL; } - qmckl_error_struct* error = (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); + qmckl_error_struct* error = + (qmckl_error_struct*) qmckl_malloc (context, sizeof(qmckl_error_struct)); error->exit_code = exit_code; - strcpy(error->function, function); + strcpy(error->function, function_name); strcpy(error->message, message); ctx->error = error; + qmckl_unlock(context); + return QMCKL_SUCCESS; } #+end_src -*** TODO Test + The ~qmckl_context_set_error~ function returns a new context with + the error domain updated. -** ~qmckl_context_set_error~ - - #+begin_src c :comments org :tangle (eval h) + # Header + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_context -qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message); +qmckl_context_set_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message); #+end_src -*** Source + # Source #+begin_src c :tangle (eval c) qmckl_context -qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message) +qmckl_context_set_error(qmckl_context context, + const qmckl_exit_code exit_code, + const char* function_name, + const char* message) { - assert (context != 0); - assert (function != NULL); + /* Passing a function name and a message is mandatory. */ + assert (function_name != NULL); assert (message != NULL); - assert (exit_code > 0); + + /* Exit codes are assumed valid. */ + assert (exit_code >= 0); + assert (exit_code != QMCKL_SUCCESS); assert (exit_code < QMCKL_INVALID_EXIT_CODE); - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return context; + /* The context is assumed to be valid */ + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_NULL_CONTEXT; - if (qmckl_context_update_error(new_context, exit_code, - function, message) != QMCKL_SUCCESS) { + qmckl_context new_context = qmckl_context_copy(context); + + /* Should be impossible because the context is valid */ + assert (new_context != QMCKL_NULL_CONTEXT); + + if (qmckl_context_update_error(new_context, + exit_code, + function_name, + message) != QMCKL_SUCCESS) { return context; } @@ -395,19 +690,14 @@ qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, } #+end_src -*** TODO Test -*** Test :noexport: - -** ~qmckl_failwith~ - - To make a function fail, the <<<~qmckl_failwith~>>> function should be + 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. The return code of the function is the desired return code. - #+begin_src c :comments org :tangle (eval h) + #+begin_src c :comments org :tangle (eval h) :exports none qmckl_exit_code qmckl_failwith(qmckl_context context, const qmckl_exit_code exit_code, const char* function, @@ -420,15 +710,21 @@ qmckl_exit_code qmckl_failwith(qmckl_context context, const char* function, const char* message) { - if (context == 0) return QMCKL_NULL_CONTEXT; assert (exit_code > 0); assert (exit_code < QMCKL_INVALID_EXIT_CODE); assert (function != NULL); assert (message != NULL); assert (strlen(function) < QMCKL_MAX_FUN_LEN); assert (strlen(message) < QMCKL_MAX_MSG_LEN); + + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) + return QMCKL_NULL_CONTEXT; - context = qmckl_context_set_error(context, exit_code, function, message); + const qmckl_exit_code rc = + qmckl_context_update_error(context, exit_code, function, message); + + assert (rc == QMCKL_SUCCESS); + return exit_code; } @@ -446,7 +742,375 @@ if (x < 0) { # To decode the error messages, ~qmckl_strerror~ converts an # error code into a string. -* Basis set + +* Control of the numerical precision + + Controlling numerical precision enables optimizations. Here, the + default parameters determining the target numerical precision and + range are defined. + + #+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 result +""" 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)" ] +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) :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) +#define QMCKL_DEFAULT_PRECISION 53 +#define QMCKL_DEFAULT_RANGE 11 +#+end_src + +#+begin_src f90 :comments org :tangle (eval fh) :exports none + integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 + integer, parameter :: QMCKL_DEFAULT_RANGE = 11 +#+end_src +:end: + + #+NAME: qmckl_precision_struct + #+begin_src c :comments org :tangle no +typedef struct qmckl_precision_struct { + int precision; + int range; +} qmckl_precision_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_update_precision~ modifies the parameter for the + numerical precision in a context. If the context doesn't have any + precision set yet, the default values are used. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_exit_code qmckl_context_update_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_context_update_precision", + "precision < 2"); + } + +if (precision > 53) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_context_update_precision", + "precision > 53"); + } + +qmckl_context_struct* ctx = (qmckl_context_struct*) context; + +/* This should be always true */ +assert (ctx != NULL); + +qmckl_lock(context); + +if (ctx->fp == NULL) { + + ctx->fp = (qmckl_precision_struct*) + qmckl_malloc(context, sizeof(qmckl_precision_struct)); + + if (ctx->fp == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "qmckl_context_update_precision", + "ctx->fp"); + } + + ctx->fp->precision = QMCKL_DEFAULT_PRECISION; + ctx->fp->range = QMCKL_DEFAULT_RANGE; + } + +ctx->fp->precision = precision; + +qmckl_unlock(context); + +return QMCKL_SUCCESS; +} + #+end_src + + # Fortran interface + + #+begin_src f90 :tangle (eval fh) + interface + integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: precision + end function qmckl_context_update_precision + end interface + #+end_src + + ~qmckl_context_set_precision~ returns a copy of the context with a + different precision parameter. + + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { + qmckl_context new_context = qmckl_context_copy(context); + if (new_context == 0) return 0; + + if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0; + + return new_context; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: precision + end function qmckl_context_set_precision + end interface + #+end_src + + ~qmckl_context_get_precision~ returns the value of the numerical precision in the context. + + #+begin_src c :comments org :tangle (eval h) :exports none +int32_t qmckl_context_get_precision(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +int qmckl_context_get_precision(const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith(context, + QMCKL_INVALID_CONTEXT, + "qmckl_context_get_precision", + ""); + } + + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + if (ctx->fp != NULL) + return ctx->fp->precision; + else + return QMCKL_DEFAULT_PRECISION; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) + interface + integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_precision + end interface + #+end_src + +** Range + + ~qmckl_context_update_range~ modifies the parameter for the numerical range in a given context. + + # Header + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +qmckl_exit_code qmckl_context_update_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_context_update_range", + "range < 2"); + } + + if (range > 11) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_context_update_range", + "range > 11"); + } + + qmckl_context_struct* ctx = (qmckl_context_struct*) context; + + /* This should be always true */ + assert (ctx != NULL); + + qmckl_lock(context); + + if (ctx->fp == NULL) { + + ctx->fp = (qmckl_precision_struct*) + qmckl_malloc(context, sizeof(qmckl_precision_struct)); + + if (ctx->fp == NULL) { + return qmckl_failwith(context, + QMCKL_ALLOCATION_FAILED, + "qmckl_context_update_range", + "ctx->fp"); + } + + ctx->fp->precision = QMCKL_DEFAULT_PRECISION; + ctx->fp->range = QMCKL_DEFAULT_RANGE; + } + + ctx->fp->range = range; + + qmckl_unlock(context); + + return QMCKL_SUCCESS; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) + interface + integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: range + end function qmckl_context_update_range + end interface + #+end_src + + ~qmckl_context_set_range~ returns a copy of the context with a different precision parameter. + + #+begin_src c :comments org :tangle (eval h) :exports none +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); + #+end_src + + # Source + + #+begin_src c :tangle (eval c) +qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { + qmckl_context new_context = qmckl_context_copy(context); + if (new_context == 0) return 0; + + if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0; + + return new_context; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + integer (c_int32_t), intent(in), value :: range + end function qmckl_context_set_range + end interface + #+end_src + + ~qmckl_context_get_range~ returns the value of the numerical range in the context. + + #+begin_src c :comments org :tangle (eval h) :exports none +int32_t qmckl_context_get_range(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +int qmckl_context_get_range(const qmckl_context context) { + if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { + return qmckl_failwith(context, + QMCKL_INVALID_CONTEXT, + "qmckl_context_get_range", + ""); + } + + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + if (ctx->fp != NULL) + return ctx->fp->range; + else + return QMCKL_DEFAULT_RANGE; +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + integer (c_int32_t) function qmckl_context_get_range(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_range + end interface + #+end_src + +** Helper functions + + ~qmckl_context_get_epsilon~ returns $\epsilon = 2^{1-n}$ where ~n~ is the precision. + + #+begin_src c :comments org :tangle (eval h) :exports none +double qmckl_context_get_epsilon(const qmckl_context context); + #+end_src + + # Source + #+begin_src c :tangle (eval c) +double qmckl_context_get_epsilon(const qmckl_context context) { + const qmckl_context_struct* ctx = (qmckl_context_struct*) context; + return 1. / (double) (1 << (1 - ctx->fp->precision)); +} + #+end_src + + # Fortran interface + #+begin_src f90 :tangle (eval fh) :exports none + interface + real (c_double) function qmckl_context_get_epsilon(context) bind(C) + use, intrinsic :: iso_c_binding + integer (c_int64_t), intent(in), value :: context + end function qmckl_context_get_epsilon + end interface + #+end_src + + +* TODO Basis set For H_2 with the following basis set, @@ -524,12 +1188,17 @@ typedef struct qmckl_ao_basis_struct { #+begin_src c :comments org :tangle (eval h) qmckl_exit_code -qmckl_context_update_ao_basis(qmckl_context context , const char type, - const int64_t shell_num , const int64_t prim_num, - const int64_t * SHELL_CENTER, const int32_t * SHELL_ANG_MOM, - const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, +qmckl_context_update_ao_basis(qmckl_context context , + const char type , + const int64_t shell_num , + const int64_t prim_num , + const int64_t * SHELL_CENTER , + const int32_t * SHELL_ANG_MOM , + const double * SHELL_FACTOR , + const int64_t * SHELL_PRIM_NUM , const int64_t * SHELL_PRIM_INDEX, - const double * EXPONENT , const double * COEFFICIENT); + const double * EXPONENT , + const double * COEFFICIENT); #+end_src *** Source @@ -566,26 +1235,27 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; - qmckl_ao_basis_struct* basis = (qmckl_ao_basis_struct*) malloc (sizeof(qmckl_ao_basis_struct)); - if (basis == NULL) return QMCKL_FAILURE; + qmckl_ao_basis_struct* basis = + (qmckl_ao_basis_struct*) qmckl_malloc (context, sizeof(qmckl_ao_basis_struct)); + if (basis == NULL) return QMCKL_ALLOCATION_FAILED; /* Memory allocations */ - basis->shell_center = (int64_t*) malloc (shell_num * sizeof(int64_t)); + basis->shell_center = (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_center == NULL) { qmckl_free(context, basis); return QMCKL_FAILURE; } - basis->shell_ang_mom = (int32_t*) malloc (shell_num * sizeof(int32_t)); + basis->shell_ang_mom = (int32_t*) qmckl_malloc (context, shell_num * sizeof(int32_t)); if (basis->shell_ang_mom == NULL) { qmckl_free(context, basis->shell_center); qmckl_free(context, basis); return QMCKL_FAILURE; } - basis->shell_prim_num= (int64_t*) malloc (shell_num * sizeof(int64_t)); + basis->shell_prim_num= (int64_t*) qmckl_malloc (context, shell_num * sizeof(int64_t)); if (basis->shell_prim_num == NULL) { qmckl_free(context, basis->shell_ang_mom); qmckl_free(context, basis->shell_center); @@ -593,7 +1263,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->shell_factor = (double *) malloc (shell_num * sizeof(double )); + basis->shell_factor = (double *) qmckl_malloc (context, shell_num * sizeof(double )); if (basis->shell_factor == NULL) { qmckl_free(context, basis->shell_prim_num); qmckl_free(context, basis->shell_ang_mom); @@ -602,7 +1272,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->exponent = (double *) malloc (prim_num * sizeof(double )); + basis->exponent = (double *) qmckl_malloc (context, prim_num * sizeof(double )); if (basis->exponent == NULL) { qmckl_free(context, basis->shell_factor); qmckl_free(context, basis->shell_prim_num); @@ -612,7 +1282,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type return QMCKL_FAILURE; } - basis->coefficient = (double *) malloc (prim_num * sizeof(double )); + basis->coefficient = (double *) qmckl_malloc (context, prim_num * sizeof(double )); if (basis->coefficient == NULL) { qmckl_free(context, basis->exponent); qmckl_free(context, basis->shell_factor); @@ -745,235 +1415,45 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ *** TODO Test -* Precision - - The following functions set and get the expected required - precision and range. ~precision~ should be an integer between 2 - and 53, and ~range~ should be an integer between 2 and 11. - - The setter functions functions return a new context as a 64-bit - integer. The getter functions return the value, as a 32-bit - integer. The update functions return ~QMCKL_SUCCESS~ or - ~QMCKL_FAILURE~. - -** ~qmckl_context_update_precision~ - Modifies the parameter for the numerical precision in a given context. - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { - - if (precision < 2) return QMCKL_FAILURE; - if (precision > 53) return QMCKL_FAILURE; - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; - - ctx->precision = precision; - return QMCKL_SUCCESS; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: precision - end function qmckl_context_update_precision - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_update_range~ - Modifies the parameter for the numerical range in a given context. - #+begin_src c :comments org :tangle (eval h) -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { - - if (range < 2) return QMCKL_FAILURE; - if (range > 11) return QMCKL_FAILURE; - - qmckl_context_struct* ctx = (qmckl_context_struct*) context; - if (ctx == NULL) return QMCKL_FAILURE; - - ctx->range = range; - return QMCKL_SUCCESS; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: range - end function qmckl_context_update_range - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_set_precision~ - Returns a copy of the context with a different precision parameter. - #+begin_src c :comments org :tangle (eval h) -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return 0; - - if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0; - - return new_context; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: precision - end function qmckl_context_set_precision - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_set_range~ - Returns a copy of the context with a different precision parameter. - #+begin_src c :comments org :tangle (eval h) -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { - qmckl_context new_context = qmckl_context_copy(context); - if (new_context == 0) return 0; - - if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0; - - return new_context; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - integer (c_int32_t), intent(in), value :: range - end function qmckl_context_set_range - end interface - #+end_src - -*** TODO Tests :noexport: - -** ~qmckl_context_get_precision~ - Returns the value of the numerical precision in the context - #+begin_src c :comments org :tangle (eval h) -int32_t qmckl_context_get_precision(const qmckl_context context); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -int qmckl_context_get_precision(const qmckl_context context) { - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return ctx->precision; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_precision - end interface - #+end_src - -*** TODO Tests :noexport: -** ~qmckl_context_get_range~ - Returns the value of the numerical range in the context - #+begin_src c :comments org :tangle (eval h) -int32_t qmckl_context_get_range(const qmckl_context context); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -int qmckl_context_get_range(const qmckl_context context) { - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return ctx->range; -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - integer (c_int32_t) function qmckl_context_get_range(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_range - end interface - #+end_src - -*** TODO Tests :noexport: - -** ~qmckl_context_get_epsilon~ - Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision - #+begin_src c :comments org :tangle (eval h) -double qmckl_context_get_epsilon(const qmckl_context context); - #+end_src - -*** Source - #+begin_src c :tangle (eval c) -double qmckl_context_get_epsilon(const qmckl_context context) { - const qmckl_context_struct* ctx = (qmckl_context_struct*) context; - return pow(2.0,(double) 1-ctx->precision); -} - #+end_src - -*** Fortran interface - #+begin_src f90 :tangle (eval fh) - interface - real (c_double) function qmckl_context_get_epsilon(context) bind(C) - use, intrinsic :: iso_c_binding - integer (c_int64_t), intent(in), value :: context - end function qmckl_context_get_epsilon - end interface - #+end_src - -*** TODO Tests :noexport: - * End of files :noexport: #+begin_src c :comments link :tangle (eval h_private) #endif #+end_src - + *** Test #+begin_src c :comments link :tangle (eval c_test) 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 + diff --git a/src/qmckl_error.org b/src/qmckl_error.org index b1338e3..3a7981a 100644 --- a/src/qmckl_error.org +++ b/src/qmckl_error.org @@ -1,10 +1,7 @@ #+TITLE: Error handling #+SETUPFILE: ../docs/theme.setup - This file is written in C because it is more natural to express the - error handling in C than in Fortran. - -** Headers :noexport: +* Headers :noexport: #+NAME: filename #+begin_src elisp tangle: no @@ -22,7 +19,10 @@ MunitResult test_<>() { #+end_src -** Error handling +* +: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 @@ -35,8 +35,8 @@ typedef int32_t qmckl_exit_code; #+end_src The exit code returns the completion status of the function to the - calling program. When a function call completed successfully, the - ~QMCKL_SUCCESS~ exit code is returned. If one of the functions of + 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. @@ -54,19 +54,21 @@ typedef int32_t qmckl_exit_code; | ~QMCKL_INVALID_ARG_8~ | 8 | | ~QMCKL_INVALID_ARG_9~ | 9 | | ~QMCKL_INVALID_ARG_10~ | 10 | - | ~QMCKL_NULL_CONTEXT~ | 101 | - | ~QMCKL_FAILURE~ | 102 | - | ~QMCKL_ERRNO~ | 103 | - | ~QMCKL_INVALID_EXIT_CODE~ | 104 | + | ~QMCKL_FAILURE~ | 101 | + | ~QMCKL_ERRNO~ | 102 | + | ~QMCKL_INVALID_CONTEXT~ | 103 | + | ~QMCKL_ALLOCATION_FAILED~ | 104 | + | ~QMCKL_INVALID_EXIT_CODE~ | 105 | # 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 result + + #+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)" ] +result = [ "#+begin_src c :comments org :tangle (eval h) :exports none" ] for (text, code) in table: text=text.replace("~","") result += [ f"#define {text:30s} {code:d}" ] @@ -74,7 +76,7 @@ result += [ "#+end_src" ] result += [ "" ] -result += [ "#+begin_src f90 :comments org :tangle (eval fh)" ] +result += [ "#+begin_src f90 :comments org :tangle (eval fh) :exports none" ] for (text, code) in table: text=text.replace("~","") result += [ f" integer, parameter :: {text:30s} = {code:d}" ] @@ -86,7 +88,7 @@ return '\n'.join(result) #+RESULTS: :results: - #+begin_src c :comments org :tangle (eval h) + #+begin_src c :comments org :tangle (eval h) :exports none #define QMCKL_SUCCESS 0 #define QMCKL_INVALID_ARG_1 1 #define QMCKL_INVALID_ARG_2 2 @@ -98,13 +100,14 @@ return '\n'.join(result) #define QMCKL_INVALID_ARG_8 8 #define QMCKL_INVALID_ARG_9 9 #define QMCKL_INVALID_ARG_10 10 - #define QMCKL_NULL_CONTEXT 101 - #define QMCKL_FAILURE 102 - #define QMCKL_ERRNO 103 - #define QMCKL_INVALID_EXIT_CODE 104 + #define QMCKL_FAILURE 101 + #define QMCKL_ERRNO 102 + #define QMCKL_INVALID_CONTEXT 103 + #define QMCKL_ALLOCATION_FAILED 104 + #define QMCKL_INVALID_EXIT_CODE 105 #+end_src - #+begin_src f90 :comments org :tangle (eval fh) + #+begin_src f90 :comments org :tangle (eval fh) :exports none integer, parameter :: QMCKL_SUCCESS = 0 integer, parameter :: QMCKL_INVALID_ARG_1 = 1 integer, parameter :: QMCKL_INVALID_ARG_2 = 2 @@ -116,17 +119,17 @@ return '\n'.join(result) integer, parameter :: QMCKL_INVALID_ARG_8 = 8 integer, parameter :: QMCKL_INVALID_ARG_9 = 9 integer, parameter :: QMCKL_INVALID_ARG_10 = 10 - integer, parameter :: QMCKL_NULL_CONTEXT = 101 - integer, parameter :: QMCKL_FAILURE = 102 - integer, parameter :: QMCKL_ERRNO = 103 - integer, parameter :: QMCKL_INVALID_EXIT_CODE = 104 + integer, parameter :: QMCKL_FAILURE = 101 + integer, parameter :: QMCKL_ERRNO = 102 + integer, parameter :: QMCKL_INVALID_CONTEXT = 103 + integer, parameter :: QMCKL_ALLOCATION_FAILED = 104 + integer, parameter :: QMCKL_INVALID_EXIT_CODE = 105 #+end_src :end: - -** End of files :noexport: +* End of files :noexport: -*** Test +** Test #+begin_src c :comments link :tangle (eval c_test) return MUNIT_OK; } diff --git a/src/qmckl_footer.org b/src/qmckl_footer.org deleted file mode 100644 index ad448d6..0000000 --- a/src/qmckl_footer.org +++ /dev/null @@ -1,8 +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. - - -# -*- mode: org -*- - diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 47d6962..f70d4b6 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -15,8 +15,11 @@ optimized libraries to fine-tune the memory allocation. #+begin_src c :tangle (eval c) #include #include +#include + #include "qmckl_error.h" #include "qmckl_context.h" +#include "qmckl_context_private.h" #include "qmckl_memory.h" #+end_src @@ -26,20 +29,39 @@ optimized libraries to fine-tune the memory allocation. MunitResult test_<>() { #+end_src -* ~qmckl_malloc~ +* + 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. - Memory allocation function, letting 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. If the allocation failed, the ~NULL~ - pointer is returned. - - #+begin_src c :tangle (eval h) -void* qmckl_malloc(qmckl_context ctx, + # Header + #+begin_src c :tangle (eval h) :noexport +void* qmckl_malloc(qmckl_context context, const size_t size); #+end_src + + # Source + #+begin_src c :tangle (eval c) +void* qmckl_malloc(qmckl_context context, const size_t size) { - #+begin_src f90 :tangle (eval fh) + void * pointer = malloc( (size_t) size ); + + if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { + qmckl_exit_code rc; + rc = qmckl_context_append_memory(context, pointer, size); + assert (rc == QMCKL_SUCCESS); + } + + return pointer; +} + #+end_src + # Fortran interface + #+begin_src f90 :tangle (eval fh) :noexport interface type (c_ptr) function qmckl_malloc (context, size) bind(C) use, intrinsic :: iso_c_binding @@ -49,24 +71,11 @@ void* qmckl_malloc(qmckl_context ctx, end interface #+end_src -** Source - - #+begin_src c :tangle (eval c) -void* qmckl_malloc(qmckl_context ctx, const size_t size) { - - if (ctx == (qmckl_context) 0) {}; /* Avoid unused argument warning */ - void * result = malloc( (size_t) size ); - return result; - -} - - #+end_src - ** Test :noexport: #+begin_src c :tangle (eval c_test) int *a = NULL; munit_assert(a == NULL); - a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); + a = (int*) qmckl_malloc( QMCKL_NULL_CONTEXT, 3*sizeof(int)); munit_assert(a != NULL); a[0] = 1; a[1] = 2; @@ -99,12 +108,22 @@ qmckl_exit_code qmckl_free(qmckl_context context, ** Source #+begin_src c :tangle (eval c) qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) { + if (qmckl_context_check(context) != QMCKL_NULL_CONTEXT) { - if (context == 0) return QMCKL_INVALID_ARG_1; - if (ptr == NULL) return QMCKL_INVALID_ARG_2; + if (ptr == NULL) { + return qmckl_failwith(context, + QMCKL_INVALID_ARG_2, + "qmckl_free", + "NULL pointer"); + } + + qmckl_exit_code rc; + rc = qmckl_context_remove_memory(context, ptr); + + assert (rc == QMCKL_SUCCESS); + } free(ptr); return QMCKL_SUCCESS; - } #+end_src diff --git a/src/qmckl_precision.org b/src/qmckl_precision.org deleted file mode 100644 index ca24c0a..0000000 --- a/src/qmckl_precision.org +++ /dev/null @@ -1,58 +0,0 @@ -#+TITLE: Multi-precision -#+SETUPFILE: ../docs/theme.setup - -#+NAME: filename -#+begin_src elisp tangle: no -(file-name-nondirectory (substring buffer-file-name 0 -4)) -#+end_src - - Controlling numerical precision enables optimizations. Here, the - default parameters determining the target numerical precision and - range are defined. - - #+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 result -""" 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)" ] -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)" ] -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) -#define QMCKL_DEFAULT_PRECISION 53 -#define QMCKL_DEFAULT_RANGE 11 -#+end_src - -#+begin_src f90 :comments org :tangle (eval fh) - integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 - integer, parameter :: QMCKL_DEFAULT_RANGE = 11 -#+end_src -:end: - - -# -*- mode: org -*- -# vim: syntax=c diff --git a/src/table_of_contents b/src/table_of_contents index 7929b05..a6a9011 100644 --- a/src/table_of_contents +++ b/src/table_of_contents @@ -1,9 +1,7 @@ qmckl.org qmckl_error.org qmckl_context.org -qmckl_precision.org qmckl_memory.org qmckl_distance.org qmckl_ao.org test_qmckl.org -qmckl_footer.org diff --git a/tools/Building.org b/tools/Building.org index 12a6ab6..be6e8ab 100644 --- a/tools/Building.org +++ b/tools/Building.org @@ -69,7 +69,12 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. #+begin_src makefile # <> #+end_src +** Dependencies + #+begin_src makefile +LIBS=-lpthread + #+end_src + ** Variables #+begin_src makefile @@ -108,7 +113,7 @@ FFLAGS=-fPIC $(INCLUDE) \ -Wreal-q-constant -Wuninitialized -fbacktrace -finit-real=nan \ -ffpe-trap=zero,overflow,underflow -LIBS=-lgfortran -lm +LIBS+=-lgfortran -lm #---------------------------------------------------------- endif #+end_src @@ -124,7 +129,7 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=ifort -xHost FFLAGS=-fPIC -g -O2 $(INCLUDE) -LIBS=-lm -lifcore -lirc +LIBS+=-lm -lifcore -lirc #---------------------------------------------------------- CC=icc -xHost endif @@ -141,7 +146,7 @@ CFLAGS=-fPIC -g -O2 $(INCLUDE) FC=flang FFLAGS=fPIC -g -O2 $(INCLUDE) -LIBS=-lm +LIBS+=-lm #---------------------------------------------------------- endif #+end_src @@ -157,14 +162,17 @@ endif libqmckl.so: Makefile.generated $(MAKE) -f Makefile.generated -test: Makefile.generated +../include/qmckl.h: libqmckl.so + ../tools/build_qmckl_h.sh + +test: Makefile.generated ../include/qmckl.h $(MAKE) -f Makefile.generated test doc: $(ORG_SOURCE_FILES) $(QMCKL_ROOT)/tools/create_doc.sh clean: - $(RM) qmckl.h test_qmckl_* test_qmckl.c test_qmckl \ + $(RM) test_qmckl_* test_qmckl.c test_qmckl \ qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h \ Makefile.generated libqmckl.so *.html *.mod diff --git a/tools/build_doc.sh b/tools/build_doc.sh new file mode 100755 index 0000000..11b06ac --- /dev/null +++ b/tools/build_doc.sh @@ -0,0 +1,57 @@ +#!/bin/bash + +if [[ -z $QMCKL_ROOT ]] +then + print "QMCKL_ROOT is not defined" + exit 1 +fi + + +# Install htmlize if needed +[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || ( + cd ${QMCKL_ROOT}/docs/ + git clone https://github.com/hniksic/emacs-htmlize + cp emacs-htmlize/htmlize.el . + rm -rf emacs-htmlize + cd - +) + +[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || exit 1 + + +# Create documentation +cd ${QMCKL_ROOT}/src + +function extract_doc() +{ + HTML=${1%.org}.html + if [[ -f ${QMCKL_ROOT}/docs/$HTML && $1 -ot ${QMCKL_ROOT}/docs/$HTML ]] + then return + fi + emacs --batch \ + --load ${QMCKL_ROOT}/docs/htmlize.el \ + --load ${QMCKL_ROOT}/tools/config_doc.el \ + $i \ + --load ${QMCKL_ROOT}/tools/config_tangle.el \ + -f org-html-export-to-html || break + mv $HTML ${QMCKL_ROOT}/docs +} + +for i in *.org +do +echo +echo "======= $i =======" + extract_doc $i +done + +if [[ $? -eq 0 ]] +then + cd ${QMCKL_ROOT}/docs + rm -f index.html + ln README.html index.html + exit 0 +else + exit 2 +fi + + diff --git a/tools/build_qmckl_h.sh b/tools/build_qmckl_h.sh index 941959f..03396f3 100755 --- a/tools/build_qmckl_h.sh +++ b/tools/build_qmckl_h.sh @@ -1,13 +1,11 @@ #!/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 both +# :header-args:bash: :tangle build_qmckl_h.sh :noweb yes :shebang #!/bin/bash :comments org # :END: -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:1]] # This file was created by tools/Building.org -# Script to build the final qmckl.h file:1 ends here @@ -18,20 +16,17 @@ # Put =.h= files in the correct order: -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:3]] HEADERS="" for i in $(cat table_of_contents) do HEADERS+="${i%.org}.h " done -# Script to build the final qmckl.h file:3 ends here # Generate C header file -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:4]] OUTPUT="../include/qmckl.h" cat << EOF > ${OUTPUT} @@ -95,14 +90,12 @@ done cat << EOF >> ${OUTPUT} #endif EOF -# Script to build the final qmckl.h file:4 ends here # Generate Fortran interface file from all =qmckl_*_fh.f90= files -# [[file:Building.org::*Script to build the final qmckl.h file][Script to build the final qmckl.h file:5]] HEADERS="qmckl_*_fh.f90" OUTPUT="../include/qmckl_f.f90" @@ -161,4 +154,3 @@ done cat << EOF >> ${OUTPUT} end module qmckl EOF -# Script to build the final qmckl.h file:5 ends here diff --git a/tools/config_doc.el b/tools/config_doc.el new file mode 100755 index 0000000..9501d64 --- /dev/null +++ b/tools/config_doc.el @@ -0,0 +1,85 @@ +;; 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) +(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.")) + +(defun face-spec-default (spec) + "Get list containing at most the default entry of face SPEC. +Return nil if SPEC has no default entry." + (let* ((first (car-safe spec)) + (display (car-safe first))) + (when (eq display 'default) + (list (car-safe spec))))) + +(defun face-spec-min-color (display-atts) + "Get min-color entry of DISPLAY-ATTS pair from face spec." + (let* ((display (car-safe display-atts))) + (or (car-safe (cdr (assoc 'min-colors display))) + maximal-integer))) + +(defun face-spec-highest-color (spec) + "Search face SPEC for highest color. +That means the DISPLAY entry of SPEC +with class 'color and highest min-color value." + (let ((color-list (cl-remove-if-not + (lambda (display-atts) + (when-let ((display (car-safe display-atts)) + (class (and (listp display) + (assoc 'class display))) + (background (assoc 'background display))) + (and (member 'light (cdr background)) + (member 'color (cdr class))))) + spec))) + (cl-reduce (lambda (display-atts1 display-atts2) + (if (> (face-spec-min-color display-atts1) + (face-spec-min-color display-atts2)) + display-atts1 + display-atts2)) + (cdr color-list) + :initial-value (car color-list)))) + +(defun face-spec-t (spec) + "Search face SPEC for fall back." + (cl-find-if (lambda (display-atts) + (eq (car-safe display-atts) t)) + spec)) + +(defun my-face-attribute (face attribute &optional frame inherit) + "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'." + (let* ((face-spec (face-user-default-spec face)) + (display-attr (or (face-spec-highest-color face-spec) + (face-spec-t face-spec))) + (attr (cdr display-attr)) + (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr)))))) + ;; (message "attribute: %S" attribute) ;; for debugging + (when (and (null (eq attribute :inherit)) + (null val)) + (let ((inherited-face (my-face-attribute face :inherit))) + (when (and inherited-face + (null (eq inherited-face 'unspecified))) + (setq val (my-face-attribute inherited-face attribute))))) + ;;(message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging + (or val 'unspecified))) + +(advice-add 'face-attribute :override #'my-face-attribute) + + + diff --git a/tools/config_tangle.el b/tools/config_tangle.el index fc39218..53ca152 100755 --- a/tools/config_tangle.el +++ b/tools/config_tangle.el @@ -1,6 +1,7 @@ ;; 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/")) @@ -15,9 +16,9 @@ (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) (org-babel-do-load-languages 'org-babel-load-languages @@ -25,80 +26,14 @@ (emacs-lisp . t) (shell . t) (python . t) + (fortran . t) (C . t) (org . t) (makefile . t) )) - - -(unless (boundp 'maximal-integer) - (defconst maximal-integer (lsh -1 -1) - "Maximal integer value representable natively in emacs lisp.")) - -(defun face-spec-default (spec) - "Get list containing at most the default entry of face SPEC. -Return nil if SPEC has no default entry." - (let* ((first (car-safe spec)) - (display (car-safe first))) - (when (eq display 'default) - (list (car-safe spec))))) - -(defun face-spec-min-color (display-atts) - "Get min-color entry of DISPLAY-ATTS pair from face spec." - (let* ((display (car-safe display-atts))) - (or (car-safe (cdr (assoc 'min-colors display))) - maximal-integer))) - -(defun face-spec-highest-color (spec) - "Search face SPEC for highest color. -That means the DISPLAY entry of SPEC -with class 'color and highest min-color value." - (let ((color-list (cl-remove-if-not - (lambda (display-atts) - (when-let ((display (car-safe display-atts)) - (class (and (listp display) - (assoc 'class display))) - (background (assoc 'background display))) - (and (member 'light (cdr background)) - (member 'color (cdr class))))) - spec))) - (cl-reduce (lambda (display-atts1 display-atts2) - (if (> (face-spec-min-color display-atts1) - (face-spec-min-color display-atts2)) - display-atts1 - display-atts2)) - (cdr color-list) - :initial-value (car color-list)))) - -(defun face-spec-t (spec) - "Search face SPEC for fall back." - (cl-find-if (lambda (display-atts) - (eq (car-safe display-atts) t)) - spec)) - -(defun my-face-attribute (face attribute &optional frame inherit) - "Get FACE ATTRIBUTE from `face-user-default-spec' and not from `face-attribute'." - (let* ((face-spec (face-user-default-spec face)) - (display-attr (or (face-spec-highest-color face-spec) - (face-spec-t face-spec))) - (attr (cdr display-attr)) - (val (or (plist-get attr attribute) (car-safe (cdr (assoc attribute attr)))))) - ;; (message "attribute: %S" attribute) ;; for debugging - (when (and (null (eq attribute :inherit)) - (null val)) - (let ((inherited-face (my-face-attribute face :inherit))) - (when (and inherited-face - (null (eq inherited-face 'unspecified))) - (setq val (my-face-attribute inherited-face attribute))))) - ;; (message "face: %S attribute: %S display-attr: %S, val: %S" face attribute display-attr val) ;; for debugging - (or val 'unspecified))) - -(advice-add 'face-attribute :override #'my-face-attribute) - - -;; The following is required to compute the file names +; 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")) @@ -109,4 +44,3 @@ with class 'color and highest min-color value." (setq c_test (concat pwd "test_" name ".c")) (setq f_test (concat pwd "test_" name "_f.f90")) - diff --git a/tools/create_doc.sh b/tools/create_doc.sh deleted file mode 100755 index ecb5d7b..0000000 --- a/tools/create_doc.sh +++ /dev/null @@ -1,47 +0,0 @@ -#!/bin/bash - -set -x - -INPUT=merged.org -if [[ -z $QMCKL_ROOT ]] -then - print "QMCKL_ROOT is not defined" - exit 1 -fi - - -# Install htmlize if needed -[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || ( - cd ${QMCKL_ROOT}/docs/ - git clone https://github.com/hniksic/emacs-htmlize - cp emacs-htmlize/htmlize.el . - rm -rf emacs-htmlize - cd - -) - -[[ -f ${QMCKL_ROOT}/docs/htmlize.el ]] || exit 1 - - -# Switch to TMPDIR for easy cleanup -TMPDIR=$(mktemp -d) -${QMCKL_ROOT}/tools/merge_org.sh $TMPDIR/$INPUT -cd $TMPDIR - - -# Create documentation -emacs --batch \ - --load ${QMCKL_ROOT}/docs/htmlize.el \ - --load ${QMCKL_ROOT}/docs/config.el \ - $INPUT -f org-html-export-to-html - -if [[ $? -eq 0 ]] -then - mv index.html ${QMCKL_ROOT}/docs/ - rm -rf $TMPDIR - exit 0 -else - rm -rf $TMPDIR - exit 2 -fi - -