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

Simplify org-mode

Browse Source
This commit is contained in:
Anthony Scemama 2020-11-05 15:27:25 +01:00
parent e774a725b9
commit ccc1b835d1
8 changed files with 555 additions and 646 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/Makefile
View File

@ -5,7 +5,7 @@ FC=gfortran -g
FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan FFLAGS=-fPIC -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
LIBS=-lgfortran -lm LIBS=-lgfortran -lm
#
#CC=icc -xHost #CC=icc -xHost
#CFLAGS=-fPIC -g -O2 #CFLAGS=-fPIC -g -O2
# #
@ -24,21 +24,24 @@ OBJECT_FILES=$(filter-out $(EXCLUDED_OBJECTS), $(patsubst %.org,%.o,$(ORG_SOURCE
.PHONY: clean .PHONY: clean
.SECONDARY: # Needed to keep the produced C and Fortran files .SECONDARY: # Needed to keep the produced C and Fortran files
libqmckl.so: Makefile.generated libqmckl.so: Makefile.generated
$(MAKE) -f Makefile.generated $(MAKE) -f Makefile.generated
test: Makefile.generated test: Makefile.generated
$(MAKE) -f Makefile.generated test $(MAKE) -f Makefile.generated test
$(MERGED_ORG): $(ORG_SOURCE_FILES)
./merge_org.sh
doc:$(MERGED_ORG) doc: $(ORG_SOURCE_FILES)
./merge_org.sh
./create_doc.sh $(MERGED_ORG) ./create_doc.sh $(MERGED_ORG)
rm $(MERGED_ORG)
clean: clean:
rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod rm -f qmckl.h test_qmckl_* test_qmckl.c test_qmckl qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html *.fh *.mod
Makefile.generated: $(MERGED_ORG) Makefile create_makefile.sh Makefile.generated: Makefile create_makefile.sh $(ORG_SOURCE_FILES)
./merge_org.sh
./create_makefile.sh $(MERGED_ORG) ./create_makefile.sh $(MERGED_ORG)
rm $(MERGED_ORG)

1
src/merge_org.sh
View File

@ -6,6 +6,7 @@ for i in README.org \
qmckl_context.org \ qmckl_context.org \
qmckl_distance.org \ qmckl_distance.org \
qmckl_ao.org \ qmckl_ao.org \
qmckl_footer.org \
test_qmckl.org test_qmckl.org
do do
cat $i >> merged_qmckl.org cat $i >> merged_qmckl.org

103
src/qmckl.org
View File

@ -1,104 +1,63 @@
# -*- mode: org -*- * QMCKL header file
# vim: syntax=c
#+TITLE: QMCkl C header
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/htmlize.css"/> This file produces the =qmckl.h= header file, which is to be included
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/readtheorg.css"/> when qmckl functions are used.
#+HTML_HEAD: <script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.3/jquery.min.js"></script>
#+HTML_HEAD: <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/js/bootstrap.min.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/lib/js/jquery.stickytableheaders.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/readtheorg/js/readtheorg.js"></script>
This file produces the =qmckl.h= header file, which is included in all We also create here the =qmckl_f.f90= which is the Fortran interface file.
other C header files. It is the main entry point to the library.
We also create the =qmckl_f.f90= which is the Fortran equivalent. ** Top of header files :noexport:
#+BEGIN_SRC C :tangle qmckl.h #+BEGIN_SRC C :tangle qmckl.h
#ifndef QMCKL_H #ifndef QMCKL_H
#define QMCKL_H #define QMCKL_H
#include <stdlib.h> #include <stdlib.h>
#include <stdint.h> #include <stdint.h>
#+END_SRC #+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90 #+BEGIN_SRC f90 :tangle qmckl_f.f90
module qmckl module qmckl
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
#+END_SRC #+END_SRC
* Constants The bottoms of the files are located in the [[qmckl_footer.org]] file.
** Constants
** Success/failure *** Success/failure
These are the codes returned by the functions to indicate success These are the codes returned by the functions to indicate success
or failure. All such functions should have as a return type =qmckl_exit_code=. or failure. All such functions should have as a return type =qmckl_exit_code=.
#+BEGIN_SRC C :tangle qmckl.h #+BEGIN_SRC C :comments org :tangle qmckl.h
#define QMCKL_SUCCESS 0 #define QMCKL_SUCCESS 0
#define QMCKL_FAILURE 1 #define QMCKL_FAILURE 1
typedef int32_t qmckl_exit_code; typedef int32_t qmckl_exit_code;
typedef int64_t qmckl_context ; typedef int64_t qmckl_context ;
#+END_SRC #+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90 #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
integer, parameter :: QMCKL_SUCCESS = 0 integer, parameter :: QMCKL_SUCCESS = 0
integer, parameter :: QMCKL_FAILURE = 0 integer, parameter :: QMCKL_FAILURE = 0
#+END_SRC #+END_SRC
** Precision-related constants *** Precision-related constants
Controlling numerical precision enables optimizations. Here, the Controlling numerical precision enables optimizations. Here, the
default parameters determining the target numerical precision and default parameters determining the target numerical precision and
range are defined. range are defined.
#+BEGIN_SRC C :tangle qmckl.h #+BEGIN_SRC C :comments org :tangle qmckl.h
#define QMCKL_DEFAULT_PRECISION 53 #define QMCKL_DEFAULT_PRECISION 53
#define QMCKL_DEFAULT_RANGE 11 #define QMCKL_DEFAULT_RANGE 11
#+END_SRC #+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90 #+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
integer, parameter :: QMCKL_DEFAULT_PRECISION = 53 integer, parameter :: QMCKL_DEFAULT_PRECISION = 53
integer, parameter :: QMCKL_DEFAULT_RANGE = 11 integer, parameter :: QMCKL_DEFAULT_RANGE = 11
#+END_SRC #+END_SRC
* Header files # -*- mode: org -*-
# vim: syntax=c
All the functions expoed in the API are defined in the following
header files.
#+BEGIN_SRC C :tangle qmckl.h
#include "qmckl_memory.h"
#include "qmckl_context.h"
#include "qmckl_distance.h"
#include "qmckl_ao.h"
#+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90
! include 'qmckl_memory.fh'
include 'qmckl_context.fh'
include 'qmckl_distance.fh'
include 'qmckl_ao.fh'
#+END_SRC
* End of header
#+BEGIN_SRC C :tangle qmckl.h
#endif
#+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90
end module qmckl
#+END_SRC
* Include all other org files here :noexport:
#+INCLUDE: qmckl_memory.org
#+INCLUDE: qmckl_context.org
#+INCLUDE: qmckl_distance.org
#+INCLUDE: qmckl_ao.org

331
src/qmckl_ao.org
View File

@ -1,97 +1,79 @@
# -*- mode: org -*- * Atomic Orbitals
# vim: syntax=c
#+TITLE: Atomic Orbitals
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/htmlize.css"/>
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/readtheorg.css"/>
#+HTML_HEAD: <script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.3/jquery.min.js"></script>
#+HTML_HEAD: <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/js/bootstrap.min.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/lib/js/jquery.stickytableheaders.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/readtheorg/js/readtheorg.js"></script>
This files contains all the routines for the computation of the This files contains all the routines for the computation of the
values, gradients and Laplacian of the atomic basis functions. values, gradients and Laplacian of the atomic basis functions.
4 files are produced: 3 files are produced:
- a header file : =qmckl_ao.h=
- a source file : =qmckl_ao.f90= - a source file : =qmckl_ao.f90=
- a C test file : =test_qmckl_ao.c= - a C test file : =test_qmckl_ao.c=
- a Fortran test file : =test_qmckl_ao_f.f90= - a Fortran test file : =test_qmckl_ao_f.f90=
*** Header :noexport: ** Test :noexport:
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h #+BEGIN_SRC C :tangle test_qmckl_ao.c
#ifndef QMCKL_AO_H
#define QMCKL_AO_H
#include "qmckl_context.h"
#include "qmckl_distance.h"
#+END_SRC
*** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c
#include <math.h> #include <math.h>
#include "qmckl.h" #include "qmckl.h"
#include "munit.h" #include "munit.h"
MunitResult test_qmckl_ao() { MunitResult test_qmckl_ao() {
qmckl_context context; qmckl_context context;
context = qmckl_context_create(); context = qmckl_context_create();
#+END_SRC #+END_SRC
** Polynomials
* Polynomials \[
P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c
\]
\begin{eqnarray*}
\frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\
\frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\
\frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\
\end{eqnarray*}
\begin{eqnarray*}
\left( \frac{\partial }{\partial x^2} +
\frac{\partial }{\partial y^2} +
\frac{\partial }{\partial z^2} \right) P_l
\left(\mathbf{r},\mathbf{R}_i \right) & = &
a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\
&& b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\
&& c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1}
\end{eqnarray*}
\[ *** =qmckl_ao_powers=
P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c
\]
\begin{eqnarray*}
\frac{\partial }{\partial x} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & a (x-X_i)^{a-1} (y-Y_i)^b (z-Z_i)^c \\
\frac{\partial }{\partial y} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & b (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c \\
\frac{\partial }{\partial z} P_l\left(\mathbf{r},\mathbf{R}_i \right) & = & c (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1} \\
\end{eqnarray*}
\begin{eqnarray*}
\left( \frac{\partial }{\partial x^2} +
\frac{\partial }{\partial y^2} +
\frac{\partial }{\partial z^2} \right) P_l
\left(\mathbf{r},\mathbf{R}_i \right) & = &
a(a-1) (x-X_i)^{a-2} (y-Y_i)^b (z-Z_i)^c + \\
&& b(b-1) (x-X_i)^a (y-Y_i)^{b-1} (z-Z_i)^c + \\
&& c(c-1) (x-X_i)^a (y-Y_i)^b (z-Z_i)^{c-1}
\end{eqnarray*}
** =qmckl_ao_powers= Computes all the powers of the =n= input data up to the given
maximum value given in input for each of the $n$ points:
Computes all the powers of the =n= input data up to the given
maximum value given in input for each of the $n$ points:
\[ P_{ij} = X_j^i \] \[ P_{ij} = X_j^i \]
*** Arguments **** Arguments
| =context= | input | Global state | | =context= | input | Global state |
| =n= | input | Number of values | | =n= | input | Number of values |
| =X(n)= | input | Array containing the input values | | =X(n)= | input | Array containing the input values |
| =LMAX(n)= | input | Array containing the maximum power for each value | | =LMAX(n)= | input | Array containing the maximum power for each value |
| =P(LDP,n)= | output | Array containing all the powers of =X= | | =P(LDP,n)= | output | Array containing all the powers of =X= |
| =LDP= | input | Leading dimension of array =P= | | =LDP= | input | Leading dimension of array =P= |
*** Requirements **** Requirements
- =context= is not 0 - =context= is not 0
- =n= > 0 - =n= > 0
- =X= is allocated with at least $n \times 8$ bytes - =X= is allocated with at least $n \times 8$ bytes
- =LMAX= is allocated with at least $n \times 4$ bytes - =LMAX= is allocated with at least $n \times 4$ bytes
- =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes - =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes
- =LDP= >= $\max_i$ =LMAX[i]= - =LDP= >= $\max_i$ =LMAX[i]=
*** Header **** Header
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h #+BEGIN_SRC C :tangle qmckl.h
qmckl_exit_code qmckl_ao_powers(const qmckl_context context, qmckl_exit_code qmckl_ao_powers(const qmckl_context context,
const int64_t n, const int64_t n,
const double *X, const int32_t *LMAX, const double *X, const int32_t *LMAX,
const double *P, const int64_t LDP); const double *P, const int64_t LDP);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 #+BEGIN_SRC f90 :tangle qmckl_ao.f90
integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info) integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info)
implicit none implicit none
integer*8 , intent(in) :: context integer*8 , intent(in) :: context
@ -123,10 +105,10 @@ integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info)
end do end do
end function qmckl_ao_powers_f end function qmckl_ao_powers_f
#+END_SRC #+END_SRC
*** C interface :noexport: **** C interface :noexport:
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 #+BEGIN_SRC f90 :tangle qmckl_ao.f90
integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) & integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) &
bind(C) result(info) bind(C) result(info)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -141,9 +123,9 @@ integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) &
integer, external :: qmckl_ao_powers_f integer, external :: qmckl_ao_powers_f
info = qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) info = qmckl_ao_powers_f(context, n, X, LMAX, P, ldp)
end function qmckl_ao_powers end function qmckl_ao_powers
#+END_SRC #+END_SRC
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) bind(C) integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -155,10 +137,10 @@ end function qmckl_ao_powers
real (c_double) , intent(out) :: P(ldp,n) real (c_double) , intent(out) :: P(ldp,n)
end function qmckl_ao_powers end function qmckl_ao_powers
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90
integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C) integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C)
use qmckl use qmckl
implicit none implicit none
@ -201,55 +183,55 @@ integer(c_int32_t) function test_qmckl_ao_powers(context) bind(C)
test_qmckl_ao_powers = 0 test_qmckl_ao_powers = 0
deallocate(X,P,LMAX) deallocate(X,P,LMAX)
end function test_qmckl_ao_powers end function test_qmckl_ao_powers
#+END_SRC #+END_SRC
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c #+BEGIN_SRC C :tangle test_qmckl_ao.c
int test_qmckl_ao_powers(qmckl_context context); int test_qmckl_ao_powers(qmckl_context context);
munit_assert_int(0, ==, test_qmckl_ao_powers(context)); munit_assert_int(0, ==, test_qmckl_ao_powers(context));
#+END_SRC #+END_SRC
** =qmckl_ao_polynomial_vgl= *** =qmckl_ao_polynomial_vgl=
Computes the values, gradients and Laplacians at a given point of Computes the values, gradients and Laplacians at a given point of
all polynomials with an angular momentum up to =lmax=. all polynomials with an angular momentum up to =lmax=.
*** Arguments **** Arguments
| =context= | input | Global state | | =context= | input | Global state |
| =X(3)= | input | Array containing the coordinates of the points | | =X(3)= | input | Array containing the coordinates of the points |
| =R(3)= | input | Array containing the x,y,z coordinates of the center | | =R(3)= | input | Array containing the x,y,z coordinates of the center |
| =lmax= | input | Maximum angular momentum | | =lmax= | input | Maximum angular momentum |
| =n= | output | Number of computed polynomials | | =n= | output | Number of computed polynomials |
| =L(ldl,n)= | output | Contains a,b,c for all =n= results | | =L(ldl,n)= | output | Contains a,b,c for all =n= results |
| =ldl= | input | Leading dimension of =L= | | =ldl= | input | Leading dimension of =L= |
| =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials | | =VGL(ldv,5)= | output | Value, gradients and Laplacian of the polynomials |
| =ldv= | input | Leading dimension of array =VGL= | | =ldv= | input | Leading dimension of array =VGL= |
*** Requirements **** Requirements
- =context= is not 0 - =context= is not 0
- =n= > 0 - =n= > 0
- =lmax= >= 0 - =lmax= >= 0
- =ldl= >= 3 - =ldl= >= 3
- =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 - =ldv= >= (=lmax=+1)(=lmax=+2)(=lmax=+3)/6
- =X= is allocated with at least $3 \times 8$ bytes - =X= is allocated with at least $3 \times 8$ bytes
- =R= is allocated with at least $3 \times 8$ bytes - =R= is allocated with at least $3 \times 8$ bytes
- =L= is allocated with at least $3 \times n \times 4$ bytes - =L= is allocated with at least $3 \times n \times 4$ bytes
- =VGL= is allocated with at least $n \times 5 \times 8$ bytes - =VGL= is allocated with at least $n \times 5 \times 8$ bytes
- On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6 - On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6
*** Header **** Header
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h #+BEGIN_SRC C :tangle qmckl.h
qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context, qmckl_exit_code qmckl_ao_polynomial_vgl(const qmckl_context context,
const double *X, const double *R, const double *X, const double *R,
const int32_t lmax, const int64_t *n, const int32_t lmax, const int64_t *n,
const int32_t *L, const int64_t ldl, const int32_t *L, const int64_t ldl,
const double *VGL, const int64_t ldv); const double *VGL, const int64_t ldv);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 #+BEGIN_SRC f90 :tangle qmckl_ao.f90
integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info) integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info)
implicit none implicit none
integer*8 , intent(in) :: context integer*8 , intent(in) :: context
@ -358,10 +340,10 @@ integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL,
info = 0 info = 0
end function qmckl_ao_polynomial_vgl_f end function qmckl_ao_polynomial_vgl_f
#+END_SRC #+END_SRC
*** C interface :noexport: **** C interface :noexport:
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 #+BEGIN_SRC f90 :tangle qmckl_ao.f90
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C) result(info) bind(C) result(info)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -378,9 +360,9 @@ integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, l
integer, external :: qmckl_ao_polynomial_vgl_f integer, external :: qmckl_ao_polynomial_vgl_f
info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv)
end function qmckl_ao_polynomial_vgl end function qmckl_ao_polynomial_vgl
#+END_SRC #+END_SRC
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) & integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C) bind(C)
@ -395,9 +377,9 @@ end function qmckl_ao_polynomial_vgl
real (c_double) , intent(out) :: VGL(ldv,5) real (c_double) , intent(out) :: VGL(ldv,5)
end function qmckl_ao_polynomial_vgl end function qmckl_ao_polynomial_vgl
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90
integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C) integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
use qmckl use qmckl
implicit none implicit none
@ -490,60 +472,58 @@ integer(c_int32_t) function test_qmckl_ao_polynomial_vgl(context) bind(C)
deallocate(L,VGL) deallocate(L,VGL)
end function test_qmckl_ao_polynomial_vgl end function test_qmckl_ao_polynomial_vgl
#+END_SRC #+END_SRC
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c #+BEGIN_SRC C :tangle test_qmckl_ao.c
int test_qmckl_ao_polynomial_vgl(qmckl_context context); int test_qmckl_ao_polynomial_vgl(qmckl_context context);
munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context)); munit_assert_int(0, ==, test_qmckl_ao_polynomial_vgl(context));
#+END_SRC #+END_SRC
#+END_SRC #+END_SRC
** Gaussian basis functions
*** =qmckl_ao_gaussians_vgl=
Computes the values, gradients and Laplacians at a given point of
=n= Gaussian functions centered at the same point:
\[ v_i = exp(-a_i |X-R|^2) \]
\[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \]
\[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \]
\[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \]
\[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \]
**** Arguments
| =context= | input | Global state |
| =X(3)= | input | Array containing the coordinates of the points |
| =R(3)= | input | Array containing the x,y,z coordinates of the center |
| =n= | input | Number of computed gaussians |
| =A(n)= | input | Exponents of the Gaussians |
| =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians |
| =ldv= | input | Leading dimension of array =VGL= |
* Gaussian basis functions **** Requirements
- =context= is not 0
- =n= > 0
- =ldv= >= 5
- =A(i)= > 0 for all =i=
- =X= is allocated with at least $3 \times 8$ bytes
- =R= is allocated with at least $3 \times 8$ bytes
- =A= is allocated with at least $n \times 8$ bytes
- =VGL= is allocated with at least $n \times 5 \times 8$ bytes
** =qmckl_ao_gaussians_vgl= **** Header
#+BEGIN_SRC C :tangle qmckl.h
Computes the values, gradients and Laplacians at a given point of
=n= Gaussian functions centered at the same point:
\[ v_i = exp(-a_i |X-R|^2) \]
\[ \nabla_x v_i = -2 a_i (X_x - R_x) v_i \]
\[ \nabla_y v_i = -2 a_i (X_y - R_y) v_i \]
\[ \nabla_z v_i = -2 a_i (X_z - R_z) v_i \]
\[ \Delta v_i = a_i (4 |X-R|^2 a_i - 6) v_i \]
*** Arguments
| =context= | input | Global state |
| =X(3)= | input | Array containing the coordinates of the points |
| =R(3)= | input | Array containing the x,y,z coordinates of the center |
| =n= | input | Number of computed gaussians |
| =A(n)= | input | Exponents of the Gaussians |
| =VGL(ldv,5)= | output | Value, gradients and Laplacian of the Gaussians |
| =ldv= | input | Leading dimension of array =VGL= |
*** Requirements
- =context= is not 0
- =n= > 0
- =ldv= >= 5
- =A(i)= > 0 for all =i=
- =X= is allocated with at least $3 \times 8$ bytes
- =R= is allocated with at least $3 \times 8$ bytes
- =A= is allocated with at least $n \times 8$ bytes
- =VGL= is allocated with at least $n \times 5 \times 8$ bytes
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h
qmckl_exit_code qmckl_ao_gaussians_vgl(const qmckl_context context, qmckl_exit_code qmckl_ao_gaussians_vgl(const qmckl_context context,
const double *X, const double *R, const double *X, const double *R,
const int64_t *n, const int64_t *A, const int64_t *n, const int64_t *A,
const double *VGL, const int64_t ldv); const double *VGL, const int64_t ldv);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 #+BEGIN_SRC f90 :tangle qmckl_ao.f90
integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result(info) integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result(info)
implicit none implicit none
integer*8 , intent(in) :: context integer*8 , intent(in) :: context
@ -603,10 +583,10 @@ integer function qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) result(
end do end do
end function qmckl_ao_gaussians_vgl_f end function qmckl_ao_gaussians_vgl_f
#+END_SRC #+END_SRC
*** C interface :noexport: **** C interface :noexport:
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90 #+BEGIN_SRC f90 :tangle qmckl_ao.f90
integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) &
bind(C) result(info) bind(C) result(info)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -621,9 +601,9 @@ integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv
integer, external :: qmckl_ao_gaussians_vgl_f integer, external :: qmckl_ao_gaussians_vgl_f
info = qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv) info = qmckl_ao_gaussians_vgl_f(context, X, R, n, A, VGL, ldv)
end function qmckl_ao_gaussians_vgl end function qmckl_ao_gaussians_vgl
#+END_SRC #+END_SRC
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) & integer(c_int32_t) function qmckl_ao_gaussians_vgl(context, X, R, n, A, VGL, ldv) &
bind(C) bind(C)
@ -635,9 +615,9 @@ end function qmckl_ao_gaussians_vgl
real (c_double) , intent(out) :: VGL(ldv,5) real (c_double) , intent(out) :: VGL(ldv,5)
end function qmckl_ao_gaussians_vgl end function qmckl_ao_gaussians_vgl
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC f90 :comments link :tangle test_qmckl_ao_f.f90 #+BEGIN_SRC f90 :tangle test_qmckl_ao_f.f90
integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C) integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C)
use qmckl use qmckl
implicit none implicit none
@ -702,29 +682,28 @@ integer(c_int32_t) function test_qmckl_ao_gaussians_vgl(context) bind(C)
deallocate(VGL) deallocate(VGL)
end function test_qmckl_ao_gaussians_vgl end function test_qmckl_ao_gaussians_vgl
#+END_SRC #+END_SRC
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c #+BEGIN_SRC C :tangle test_qmckl_ao.c
int test_qmckl_ao_gaussians_vgl(qmckl_context context); int test_qmckl_ao_gaussians_vgl(qmckl_context context);
munit_assert_int(0, ==, test_qmckl_ao_gaussians_vgl(context)); munit_assert_int(0, ==, test_qmckl_ao_gaussians_vgl(context));
#+END_SRC #+END_SRC
#+END_SRC #+END_SRC
* TODO Slater basis functions ** TODO Slater basis functions
* End of files :noexport: ** End of files :noexport:
*** Header **** Test
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h #+BEGIN_SRC C :tangle test_qmckl_ao.c
#endif
#+END_SRC
*** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c
if (qmckl_context_destroy(context) != QMCKL_SUCCESS) if (qmckl_context_destroy(context) != QMCKL_SUCCESS)
return QMCKL_FAILURE; return QMCKL_FAILURE;
return MUNIT_OK; return MUNIT_OK;
} }
#+END_SRC #+END_SRC
# -*- mode: org -*-
# vim: syntax=c

475
src/qmckl_context.org
View File

@ -1,53 +1,41 @@
# -*- mode: org -*- * Context
# vim: syntax=c
#+TITLE: Context
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/htmlize.css"/> This file is written in C because it is more natural to express the context in
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/readtheorg.css"/> C than in Fortran.
#+HTML_HEAD: <script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.3/jquery.min.js"></script>
#+HTML_HEAD: <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/js/bootstrap.min.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/lib/js/jquery.stickytableheaders.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/readtheorg/js/readtheorg.js"></script>
2 files are produced:
- a source file : =qmckl_context.c=
- a test file : =test_qmckl_context.c=
This file is written in C because it is more natural to express the context in ** Headers :noexport:
C than in Fortran. #+BEGIN_SRC C :tangle qmckl_context.c
3 files are produced:
- a header file : =qmckl_context.h=
- a source file : =qmckl_context.c=
- a test file : =test_qmckl_context.c=
*** Header :noexport:
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
#ifndef QMCKL_CONTEXT_H
#define QMCKL_CONTEXT_H
#include "qmckl.h" #include "qmckl.h"
#+END_SRC #+END_SRC
*** Source :noexport: #+BEGIN_SRC C :tangle test_qmckl_context.c
#+BEGIN_SRC C :comments link :tangle qmckl_context.c
#include "qmckl.h"
#+END_SRC
*** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
#include "qmckl.h" #include "qmckl.h"
#include "munit.h" #include "munit.h"
MunitResult test_qmckl_context() { MunitResult test_qmckl_context() {
#+END_SRC #+END_SRC
* Context ** Context
The context variable is a handle for the state of the library, and The context variable is a handle for the state of the library, and
is stored in the following data structure, which can't be seen is stored in the following data structure, which can't be seen
outside of the library. To simplify compatibility with other outside of the library. To simplify compatibility with other
languages, the pointer to the internal data structure is converted languages, the pointer to the internal data structure is converted
into a 64-bit signed integer, defined in the =qmckl_context= type. into a 64-bit signed integer, defined in the =qmckl_context= type.
A value of 0 for the context is equivalent to a =NULL= pointer. A value of 0 for the context is equivalent to a =NULL= pointer.
*** Source #+BEGIN_SRC C :comments org :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+END_SRC
**** Source
The tag is used internally to check if the memory domain pointed by
a pointer is a valid context.
#+BEGIN_SRC C :comments org :tangle qmckl_context.c
typedef struct qmckl_context_struct { typedef struct qmckl_context_struct {
struct qmckl_context_struct * prev; struct qmckl_context_struct * prev;
uint32_t tag; uint32_t tag;
@ -57,31 +45,26 @@ typedef struct qmckl_context_struct {
#define VALID_TAG 0xBEEFFACE #define VALID_TAG 0xBEEFFACE
#define INVALID_TAG 0xDEADBEEF #define INVALID_TAG 0xDEADBEEF
#+END_SRC #+END_SRC
The tag is used internally to check if the memory domain pointed by **** Test :noexport:
a pointer is a valid context. #+BEGIN_SRC C :tangle test_qmckl_context.c
qmckl_context context;
*** Test :noexport: qmckl_context new_context;
We declare here the variables used in the tests. #+END_SRC
#+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
qmckl_context context;
qmckl_context new_context;
#+END_SRC
** =qmckl_context_check= *** =qmckl_context_check=
Checks if the domain pointed by the pointer is a valid context. Checks if the domain pointed by the pointer is a valid context.
Returns the input =qmckl_context= if the context is valid, 0 otherwise. Returns the input =qmckl_context= if the context is valid, 0 otherwise.
*** Header #+BEGIN_SRC C :comments org :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
qmckl_context qmckl_context_check(const qmckl_context context) ; qmckl_context qmckl_context_check(const qmckl_context context) ;
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_check(const qmckl_context context) { qmckl_context qmckl_context_check(const qmckl_context context) {
if (context == (qmckl_context) 0) return (qmckl_context) 0; if (context == (qmckl_context) 0) return (qmckl_context) 0;
@ -92,21 +75,20 @@ qmckl_context qmckl_context_check(const qmckl_context context) {
return context; return context;
} }
#+END_SRC #+END_SRC
** =qmckl_context_create= *** =qmckl_context_create=
To create a new context, use =qmckl_context_create()=. To create a new context, use =qmckl_context_create()=.
- On success, returns a pointer to a context using the =qmckl_context= type - On success, returns a pointer to a context using the =qmckl_context= type
- Returns 0 upon failure to allocate the internal data structure - Returns 0 upon failure to allocate the internal data structure
*** Header #+BEGIN_SRC C :comments org :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
qmckl_context qmckl_context_create(); qmckl_context qmckl_context_create();
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_create() { qmckl_context qmckl_context_create() {
qmckl_context_struct* context = qmckl_context_struct* context =
@ -122,39 +104,38 @@ qmckl_context qmckl_context_create() {
return (qmckl_context) context; return (qmckl_context) context;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int64_t) function qmckl_context_create() bind(C) integer (c_int64_t) function qmckl_context_create() bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
end function qmckl_context_create end function qmckl_context_create
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_context.c #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
context = qmckl_context_create(); context = qmckl_context_create();
munit_assert_int64( context, !=, (qmckl_context) 0); munit_assert_int64( context, !=, (qmckl_context) 0);
munit_assert_int64( qmckl_context_check(context), ==, context); munit_assert_int64( qmckl_context_check(context), ==, context);
#+END_SRC #+END_SRC
** =qmckl_context_copy= *** =qmckl_context_copy=
This function makes a shallow copy of the current context. This function makes a shallow copy of the current context.
- Copying the 0-valued context returns 0 - Copying the 0-valued context returns 0
- On success, returns a pointer to the new context using the =qmckl_context= type - On success, returns a pointer to the new context using the =qmckl_context= type
- Returns 0 upon failure to allocate the internal data structure - Returns 0 upon failure to allocate the internal data structure
for the new context for the new context
*** Header #+BEGIN_SRC C :comments org :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
qmckl_context qmckl_context_copy(const qmckl_context context); qmckl_context qmckl_context_copy(const qmckl_context context);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_copy(const qmckl_context context) { qmckl_context qmckl_context_copy(const qmckl_context context) {
const qmckl_context checked_context = qmckl_context_check(context); const qmckl_context checked_context = qmckl_context_check(context);
@ -179,40 +160,39 @@ qmckl_context qmckl_context_copy(const qmckl_context context) {
return (qmckl_context) new_context; return (qmckl_context) new_context;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int64_t) function qmckl_context_copy(context) bind(C) integer (c_int64_t) function qmckl_context_copy(context) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context integer (c_int64_t), intent(in), value :: context
end function qmckl_context_copy end function qmckl_context_copy
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_context.c #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
new_context = qmckl_context_copy(context); new_context = qmckl_context_copy(context);
munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int64(new_context, !=, (qmckl_context) 0);
munit_assert_int64(new_context, !=, context); munit_assert_int64(new_context, !=, context);
munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
#+END_SRC #+END_SRC
** =qmckl_context_previous= *** =qmckl_context_previous=
Returns the previous context Returns the previous context
- On success, returns the ancestor of the current context - On success, returns the ancestor of the current context
- Returns 0 for the initial context - Returns 0 for the initial context
- Returns 0 for the 0-valued context - Returns 0 for the 0-valued context
*** Header #+BEGIN_SRC C :comments org :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
qmckl_context qmckl_context_previous(const qmckl_context context); qmckl_context qmckl_context_previous(const qmckl_context context);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_previous(const qmckl_context context) { qmckl_context qmckl_context_previous(const qmckl_context context) {
const qmckl_context checked_context = qmckl_context_check(context); const qmckl_context checked_context = qmckl_context_check(context);
@ -223,41 +203,40 @@ qmckl_context qmckl_context_previous(const qmckl_context context) {
const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context;
return qmckl_context_check((qmckl_context) ctx->prev); return qmckl_context_check((qmckl_context) ctx->prev);
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int64_t) function qmckl_context_previous(context) bind(C) integer (c_int64_t) function qmckl_context_previous(context) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context integer (c_int64_t), intent(in), value :: context
end function qmckl_context_previous end function qmckl_context_previous
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_context.c #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous(new_context), !=, (qmckl_context) 0);
munit_assert_int64(qmckl_context_previous(new_context), ==, 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(context), ==, (qmckl_context) 0);
munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0);
#+END_SRC #+END_SRC
** =qmckl_context_destroy= *** =qmckl_context_destroy=
Destroys the current context, leaving the ancestors untouched. Destroys the current context, leaving the ancestors untouched.
- Succeeds if the current context is properly destroyed - Succeeds if the current context is properly destroyed
- Fails otherwise - Fails otherwise
- Fails if the 0-valued context is given in argument - Fails if the 0-valued context is given in argument
- Fails if the the pointer is not a valid context - Fails if the the pointer is not a valid context
*** Header #+BEGIN_SRC C :comments org :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
qmckl_exit_code qmckl_context_destroy(qmckl_context context); qmckl_exit_code qmckl_context_destroy(qmckl_context context);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { qmckl_exit_code qmckl_context_destroy(const qmckl_context context) {
const qmckl_context checked_context = qmckl_context_check(context); const qmckl_context checked_context = qmckl_context_check(context);
@ -270,47 +249,47 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) {
qmckl_free(ctx); qmckl_free(ctx);
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int32_t) function qmckl_context_destroy(context) bind(C) integer (c_int32_t) function qmckl_context_destroy(context) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context integer (c_int64_t), intent(in), value :: context
end function qmckl_context_destroy end function qmckl_context_destroy
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_context.c #+BEGIN_SRC C :tangle test_qmckl_context.c
munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int64(new_context, !=, (qmckl_context) 0);
munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); 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), !=, new_context);
munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0);
munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE);
#+END_SRC #+END_SRC
* Precision ** Precision
The following functions set and get the expected required precision The following functions set and get the expected required precision
and range. =precision= should be an integer between 2 and 53, and and range. =precision= should be an integer between 2 and 53, and
=range= should be an integer between 2 and 11. =range= should be an integer between 2 and 11.
The setter functions functions return a new context as a 64-bit integer. 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 getter functions return the value, as a 32-bit integer.
The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=. The update functions return =QMCKL_SUCCESS= or =QMCKL_FAILURE=.
** =qmckl_context_update_precision= *** =qmckl_context_update_precision=
*** Header Modifies the parameter for the numerical precision in a given context.
#+BEGIN_SRC C :comments link :tangle qmckl_context.h #+BEGIN_SRC C :comments org :tangle qmckl.h
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) {
if (precision < 2) return QMCKL_FAILURE; if (precision < 2) return QMCKL_FAILURE;
@ -322,10 +301,10 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons
ctx->precision = precision; ctx->precision = precision;
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -333,17 +312,17 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons
integer (c_int32_t), intent(in), value :: precision integer (c_int32_t), intent(in), value :: precision
end function qmckl_context_update_precision end function qmckl_context_update_precision
end interface end interface
#+END_SRC #+END_SRC
*** TODO Tests :noexport: **** TODO Tests :noexport:
** =qmckl_context_update_range= *** =qmckl_context_update_range=
*** Header Modifies the parameter for the numerical range in a given context.
#+BEGIN_SRC C :comments link :tangle qmckl_context.h #+BEGIN_SRC C :comments org :tangle qmckl.h
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) {
if (range < 2) return QMCKL_FAILURE; if (range < 2) return QMCKL_FAILURE;
@ -355,10 +334,10 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in
ctx->range = range; ctx->range = range;
return QMCKL_SUCCESS; return QMCKL_SUCCESS;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -366,17 +345,17 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in
integer (c_int32_t), intent(in), value :: range integer (c_int32_t), intent(in), value :: range
end function qmckl_context_update_range end function qmckl_context_update_range
end interface end interface
#+END_SRC
**** TODO Tests :noexport:
*** =qmckl_context_set_precision=
Returns a copy of the context with a different precision parameter.
#+BEGIN_SRC C :comments or :tangle qmckl.h
qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision);
#+END_SRC #+END_SRC
*** TODO Tests :noexport: **** Source
** =qmckl_context_set_precision= #+BEGIN_SRC C :tangle qmckl_context.c
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision);
#+END_SRC
*** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c
qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) {
qmckl_context new_context = qmckl_context_copy(context); qmckl_context new_context = qmckl_context_copy(context);
if (new_context == 0) return 0; if (new_context == 0) return 0;
@ -385,10 +364,10 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int
return new_context; return new_context;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int32_t) function qmckl_context_set_precision(context, precision) bind(C) integer (c_int32_t) function qmckl_context_set_precision(context, precision) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -396,17 +375,17 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int
integer (c_int32_t), intent(in), value :: precision integer (c_int32_t), intent(in), value :: precision
end function qmckl_context_set_precision end function qmckl_context_set_precision
end interface end interface
#+END_SRC
**** TODO Tests :noexport:
*** =qmckl_context_set_range=
Returns a copy of the context with a different precision parameter.
#+BEGIN_SRC C :comments org :tangle qmckl.h
qmckl_context qmckl_context_set_range(const qmckl_context context, const int range);
#+END_SRC #+END_SRC
*** TODO Tests :noexport: **** Source
** =qmckl_context_set_range= #+BEGIN_SRC C :tangle qmckl_context.c
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
qmckl_context qmckl_context_set_range(const qmckl_context context, const int range);
#+END_SRC
*** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c
qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) {
qmckl_context new_context = qmckl_context_copy(context); qmckl_context new_context = qmckl_context_copy(context);
if (new_context == 0) return 0; if (new_context == 0) return 0;
@ -415,10 +394,10 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran
return new_context; return new_context;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int32_t) function qmckl_context_set_range(context, range) bind(C) integer (c_int32_t) function qmckl_context_set_range(context, range) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -426,104 +405,102 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran
integer (c_int32_t), intent(in), value :: range integer (c_int32_t), intent(in), value :: range
end function qmckl_context_set_range end function qmckl_context_set_range
end interface end interface
#+END_SRC
**** TODO Tests :noexport:
*** =qmckl_context_get_precision=
Returns the value of the numerical precision in the context
#+BEGIN_SRC C :comments org :tangle qmckl.h
int32_t qmckl_context_get_precision(const qmckl_context context);
#+END_SRC #+END_SRC
*** TODO Tests :noexport: **** Source
#+BEGIN_SRC C :tangle qmckl_context.c
** =qmckl_context_get_precision=
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
int32_t qmckl_context_get_precision(const qmckl_context context);
#+END_SRC
*** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c
int qmckl_context_get_precision(const qmckl_context context) { int qmckl_context_get_precision(const qmckl_context context) {
const qmckl_context_struct* ctx = (qmckl_context_struct*) context; const qmckl_context_struct* ctx = (qmckl_context_struct*) context;
return ctx->precision; return ctx->precision;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) integer (c_int32_t) function qmckl_context_get_precision(context) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context integer (c_int64_t), intent(in), value :: context
end function qmckl_context_get_precision end function qmckl_context_get_precision
end interface end interface
#+END_SRC
**** TODO Tests :noexport:
*** =qmckl_context_get_range=
Returns the value of the numerical range in the context
#+BEGIN_SRC C :comments org :tangle qmckl.h
int32_t qmckl_context_get_range(const qmckl_context context);
#+END_SRC #+END_SRC
*** TODO Tests :noexport: **** Source
** =qmckl_context_get_range= #+BEGIN_SRC C :tangle qmckl_context.c
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
int32_t qmckl_context_get_range(const qmckl_context context);
#+END_SRC
*** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c
int qmckl_context_get_range(const qmckl_context context) { int qmckl_context_get_range(const qmckl_context context) {
const qmckl_context_struct* ctx = (qmckl_context_struct*) context; const qmckl_context_struct* ctx = (qmckl_context_struct*) context;
return ctx->range; return ctx->range;
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer (c_int32_t) function qmckl_context_get_range(context) bind(C) integer (c_int32_t) function qmckl_context_get_range(context) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context integer (c_int64_t), intent(in), value :: context
end function qmckl_context_get_range end function qmckl_context_get_range
end interface end interface
#+END_SRC
**** TODO Tests :noexport:
*** =qmckl_context_get_epsilon=
Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision
#+BEGIN_SRC C :comments org :tangle qmckl.h
double qmckl_context_get_epsilon(const qmckl_context context);
#+END_SRC #+END_SRC
*** TODO Tests :noexport: **** Source
#+BEGIN_SRC C :tangle qmckl_context.c
** =qmckl_context_get_epsilon=
Returns $\epsilon = 2 / \log_{10} 2^{n-1}$ where =n= is the precision
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_context.h
double qmckl_context_get_epsilon(const qmckl_context context);
#+END_SRC
*** Source
#+BEGIN_SRC C :comments link :tangle qmckl_context.c
double qmckl_context_get_epsilon(const qmckl_context context) { double qmckl_context_get_epsilon(const qmckl_context context) {
const qmckl_context_struct* ctx = (qmckl_context_struct*) context; const qmckl_context_struct* ctx = (qmckl_context_struct*) context;
return 1.0 / ((double) ((int64_t) 1 << (ctx->precision-1))); return 1.0 / ((double) ((int64_t) 1 << (ctx->precision-1)));
} }
#+END_SRC #+END_SRC
*** Fortran interface **** Fortran interface
#+BEGIN_SRC f90 :comments link :tangle qmckl_context.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
real (c_double) function qmckl_context_get_epsilon(context) bind(C) real (c_double) function qmckl_context_get_epsilon(context) bind(C)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context integer (c_int64_t), intent(in), value :: context
end function qmckl_context_get_epsilon end function qmckl_context_get_epsilon
end interface end interface
#+END_SRC #+END_SRC
*** TODO Tests :noexport: **** TODO Tests :noexport:
* Info about the molecular system ** Info about the molecular system
** TODO =qmckl_context_set_nucl_coord= *** TODO =qmckl_context_set_nucl_coord=
** TODO =qmckl_context_set_nucl_charge= *** TODO =qmckl_context_set_nucl_charge=
** TODO =qmckl_context_set_elec_num= *** TODO =qmckl_context_set_elec_num=
* End of files :noexport: ** End of files :noexport:
*** Header **** Test
#+BEGIN_SRC C :comments link :tangle qmckl_context.h #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
#endif return MUNIT_OK;
#+END_SRC
*** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
return MUNIT_OK;
} }
#+END_SRC #+END_SRC
# -*- mode: org -*-
# vim: syntax=c

141
src/qmckl_distance.org
View File

@ -1,30 +1,13 @@
# -*- mode: org -*- * Computation of distances
# vim: syntax=c
#+TITLE: Computation of distances
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/htmlize.css"/>
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/readtheorg.css"/>
#+HTML_HEAD: <script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.3/jquery.min.js"></script>
#+HTML_HEAD: <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/js/bootstrap.min.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/lib/js/jquery.stickytableheaders.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/readtheorg/js/readtheorg.js"></script>
Function for the computation of distances between particles. Function for the computation of distances between particles.
4 files are produced: 3 files are produced:
- a header file : =qmckl_distance.h=
- a source file : =qmckl_distance.f90= - a source file : =qmckl_distance.f90=
- a C test file : =test_qmckl_distance.c= - a C test file : =test_qmckl_distance.c=
- a Fortran test file : =test_qmckl_distance_f.f90= - a Fortran test file : =test_qmckl_distance_f.f90=
*** Header :noexport: *** Headers :noexport:
#+BEGIN_SRC C :comments link :tangle qmckl_distance.h
#ifndef QMCKL_DISTANCE_H
#define QMCKL_DISTANCE_H
#include "qmckl_context.h"
#+END_SRC
*** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
#include <math.h> #include <math.h>
#include "qmckl.h" #include "qmckl.h"
@ -36,61 +19,60 @@ MunitResult test_qmckl_distance() {
#+END_SRC #+END_SRC
* Squared distance ** Squared distance
** =qmckl_distance_sq= *** =qmckl_distance_sq=
Computes the matrix of the squared distances between all pairs of Computes the matrix of the squared distances between all pairs of
points in two sets, one point within each set: points in two sets, one point within each set:
\[ \[
C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2 C_{ij} = \sum_{k=1}^3 (A_{k,i}-B_{k,j})^2
\] \]
*** Arguments **** Arguments
| =context= | input | Global state | | =context= | input | Global state |
| =transa= | input | Array =A= is =N=: Normal, =T=: Transposed | | =transa= | input | Array =A= is =N=: Normal, =T=: Transposed |
| =transb= | input | Array =B= is =N=: Normal, =T=: Transposed | | =transb= | input | Array =B= is =N=: Normal, =T=: Transposed |
| =m= | input | Number of points in the first set | | =m= | input | Number of points in the first set |
| =n= | input | Number of points in the second set | | =n= | input | Number of points in the second set |
| =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ | | =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ |
| =lda= | input | Leading dimension of array =A= | | =lda= | input | Leading dimension of array =A= |
| =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ | | =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ |
| =ldb= | input | Leading dimension of array =B= | | =ldb= | input | Leading dimension of array =B= |
| =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ | | =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ |
| =ldc= | input | Leading dimension of array =C= | | =ldc= | input | Leading dimension of array =C= |
*** Requirements **** Requirements
- =context= is not 0 - =context= is not 0
- =m= > 0 - =m= > 0
- =n= > 0 - =n= > 0
- =lda= >= 3 if =transa= is =N= - =lda= >= 3 if =transa= is =N=
- =lda= >= m if =transa= is =T= - =lda= >= m if =transa= is =T=
- =ldb= >= 3 if =transb= is =N= - =ldb= >= 3 if =transb= is =N=
- =ldb= >= n if =transb= is =T= - =ldb= >= n if =transb= is =T=
- =ldc= >= m if =transa= is = - =ldc= >= m if =transa= is =
- =A= is allocated with at least $3 \times m \times 8$ bytes - =A= is allocated with at least $3 \times m \times 8$ bytes
- =B= is allocated with at least $3 \times n \times 8$ bytes - =B= is allocated with at least $3 \times n \times 8$ bytes
- =C= is allocated with at least $m \times n \times 8$ bytes - =C= is allocated with at least $m \times n \times 8$ bytes
*** Performance **** Performance
This function might be more efficient when =A= and =B= are This function might be more efficient when =A= and =B= are
transposed. transposed.
*** Header #+BEGIN_SRC C :comments org :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_distance.h
qmckl_exit_code qmckl_distance_sq(const qmckl_context context, qmckl_exit_code qmckl_distance_sq(const qmckl_context context,
const char transa, const char transb, const char transa, const char transb,
const int64_t m, const int64_t n, const int64_t m, const int64_t n,
const double *A, const int64_t lda, const double *A, const int64_t lda,
const double *B, const int64_t ldb, const double *B, const int64_t ldb,
const double *C, const int64_t ldc); const double *C, const int64_t ldc);
#+END_SRC #+END_SRC
*** Source **** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 #+BEGIN_SRC f90 :tangle qmckl_distance.f90
integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info) integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) result(info)
implicit none implicit none
integer*8 , intent(in) :: context integer*8 , intent(in) :: context
@ -215,10 +197,10 @@ integer function qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, L
end select end select
end function qmckl_distance_sq_f end function qmckl_distance_sq_f
#+END_SRC #+END_SRC
*** C interface :noexport: **** C interface :noexport:
#+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90 #+BEGIN_SRC f90 :tangle qmckl_distance.f90
integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) &
bind(C) result(info) bind(C) result(info)
use, intrinsic :: iso_c_binding use, intrinsic :: iso_c_binding
@ -236,9 +218,9 @@ integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A,
integer, external :: qmckl_distance_sq_f integer, external :: qmckl_distance_sq_f
info = qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) info = qmckl_distance_sq_f(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC)
end function qmckl_distance_sq end function qmckl_distance_sq
#+END_SRC #+END_SRC
#+BEGIN_SRC f90 :comments link :tangle qmckl_distance.fh #+BEGIN_SRC f90 :tangle qmckl_f.f90
interface interface
integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) & integer(c_int32_t) function qmckl_distance_sq(context, transa, transb, m, n, A, LDA, B, LDB, C, LDC) &
bind(C) bind(C)
@ -255,14 +237,13 @@ end function qmckl_distance_sq
real (c_double) , intent(out) :: C(ldc,n) real (c_double) , intent(out) :: C(ldc,n)
end function qmckl_distance_sq end function qmckl_distance_sq
end interface end interface
#+END_SRC #+END_SRC
*** Test :noexport: **** Test :noexport:
#+BEGIN_SRC f90 :comments link :tangle test_qmckl_distance_f.f90 #+BEGIN_SRC f90 :tangle test_qmckl_distance_f.f90
integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C) integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
use, intrinsic :: iso_c_binding use qmckl
implicit none implicit none
include 'qmckl_distance.fh'
integer(c_int64_t), intent(in), value :: context integer(c_int64_t), intent(in), value :: context
double precision, allocatable :: A(:,:), B(:,:), C(:,:) double precision, allocatable :: A(:,:), B(:,:), C(:,:)
@ -355,24 +336,22 @@ integer(c_int32_t) function test_qmckl_distance_sq(context) bind(C)
deallocate(A,B,C) deallocate(A,B,C)
end function test_qmckl_distance_sq end function test_qmckl_distance_sq
#+END_SRC #+END_SRC
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
int test_qmckl_distance_sq(qmckl_context context); int test_qmckl_distance_sq(qmckl_context context);
munit_assert_int(0, ==, test_qmckl_distance_sq(context)); munit_assert_int(0, ==, test_qmckl_distance_sq(context));
#+END_SRC #+END_SRC
* End of files :noexport: ** End of files :noexport:
*** Header #+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
#+BEGIN_SRC C :comments link :tangle qmckl_distance.h
#endif
#+END_SRC
*** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_distance.c
if (qmckl_context_destroy(context) != QMCKL_SUCCESS) if (qmckl_context_destroy(context) != QMCKL_SUCCESS)
return QMCKL_FAILURE; return QMCKL_FAILURE;
return MUNIT_OK; return MUNIT_OK;
} }
#+END_SRC #+END_SRC
# -*- mode: org -*-
# vim: syntax=c

13
src/qmckl_footer.org Normal file
View File

@ -0,0 +1,13 @@
* End of header files :noexport:
#+BEGIN_SRC C :tangle qmckl.h
#endif
#+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90
end module qmckl
#+END_SRC
# -*- mode: org -*-

122
src/qmckl_memory.org
View File

@ -1,52 +1,44 @@
# -*- mode: org -*- * Memory management
# vim: syntax=c
#+TITLE: Memory management
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/htmlize.css"/>
#+HTML_HEAD: <link rel="stylesheet" type="text/css" href="http://www.pirilampo.org/styles/readtheorg/css/readtheorg.css"/>
#+HTML_HEAD: <script src="https://ajax.googleapis.com/ajax/libs/jquery/2.1.3/jquery.min.js"></script>
#+HTML_HEAD: <script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.4/js/bootstrap.min.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/lib/js/jquery.stickytableheaders.js"></script>
#+HTML_HEAD: <script type="text/javascript" src="http://www.pirilampo.org/styles/readtheorg/js/readtheorg.js"></script>
We override the allocation functions to enable the possibility of We override the allocation functions to enable the possibility of
optimized libraries to fine-tune the memory allocation. optimized libraries to fine-tune the memory allocation.
3 files are produced: 2 files are produced:
- a header file : =qmckl_memory.h=
- a source file : =qmckl_memory.c= - a source file : =qmckl_memory.c=
- a test file : =test_qmckl_memory.c= - a test file : =test_qmckl_memory.c=
** Header :noexport: ** Headers :noexport:
#+BEGIN_SRC C :comments link :tangle qmckl_memory.h #+BEGIN_SRC C :tangle qmckl_memory.c
#ifndef QMCKL_MEMORY_H
#define QMCKL_MEMORY_H
#include "qmckl.h" #include "qmckl.h"
#+END_SRC #+END_SRC
** Source :noexport: #+BEGIN_SRC C :tangle test_qmckl_memory.c
#+BEGIN_SRC C :comments link :tangle qmckl_memory.c
#include <stdlib.h>
#include "qmckl_memory.h"
#+END_SRC
** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c
#include "qmckl.h" #include "qmckl.h"
#include "munit.h" #include "munit.h"
MunitResult test_qmckl_memory() { MunitResult test_qmckl_memory() {
#+END_SRC #+END_SRC
* =qmckl_malloc= ** =qmckl_malloc=
Analogous of =malloc, but passing a context and a signed 64-bit integers as argument.=
** Header Memory allocation function, letting the library choose how the
#+BEGIN_SRC C :comments link :tangle qmckl_memory.h memory will be allocated, and a pointer is returned to the user.
#+BEGIN_SRC C :tangle qmckl.h
void* qmckl_malloc(const qmckl_context ctx, const size_t size); void* qmckl_malloc(const qmckl_context ctx, const size_t size);
#+END_SRC #+END_SRC
** Source #+BEGIN_SRC f90 :tangle qmckl_f.f90
#+BEGIN_SRC C :comments link :tangle qmckl_memory.c interface
type (c_ptr) function qmckl_malloc (context, size) bind(C)
use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context
integer (c_int64_t), intent(in), value :: size
end function qmckl_malloc
end interface
#+END_SRC
*** Source
#+BEGIN_SRC C :tangle qmckl_memory.c
void* qmckl_malloc(const qmckl_context ctx, const size_t size) { void* qmckl_malloc(const qmckl_context ctx, const size_t size) {
if (ctx == (qmckl_context) 0) { if (ctx == (qmckl_context) 0) {
/* Avoids unused parameter error */ /* Avoids unused parameter error */
@ -55,49 +47,55 @@ void* qmckl_malloc(const qmckl_context ctx, const size_t size) {
return malloc( (size_t) size ); return malloc( (size_t) size );
} }
#+END_SRC #+END_SRC
** Test :noexport: *** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c #+BEGIN_SRC C :tangle test_qmckl_memory.c
int *a; int *a;
a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int)); a = (int*) qmckl_malloc( (qmckl_context) 1, 3*sizeof(int));
a[0] = 1; a[0] = 1;
a[1] = 2; a[1] = 2;
a[2] = 3; a[2] = 3;
munit_assert_int(a[0], ==, 1); munit_assert_int(a[0], ==, 1);
munit_assert_int(a[1], ==, 2); munit_assert_int(a[1], ==, 2);
munit_assert_int(a[2], ==, 3); munit_assert_int(a[2], ==, 3);
#+END_SRC #+END_SRC
* =qmckl_free= ** =qmckl_free=
** Header #+BEGIN_SRC C :tangle qmckl.h
#+BEGIN_SRC C :comments link :tangle qmckl_memory.h
void qmckl_free(void *ptr); void qmckl_free(void *ptr);
#+END_SRC #+END_SRC
** Source #+BEGIN_SRC f90 :tangle qmckl_f.f90
#+BEGIN_SRC C :comments link :tangle qmckl_memory.c interface
subroutine qmckl_free (ptr) bind(C)
use, intrinsic :: iso_c_binding
type (c_ptr), intent(in), value :: ptr
end subroutine qmckl_free
end interface
#+END_SRC
*** Source
#+BEGIN_SRC C :tangle qmckl_memory.c
void qmckl_free(void *ptr) { void qmckl_free(void *ptr) {
free(ptr); free(ptr);
} }
#+END_SRC #+END_SRC
** Test :noexport: *** Test :noexport:
#+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c #+BEGIN_SRC C :tangle test_qmckl_memory.c
qmckl_free(a); qmckl_free(a);
#+END_SRC #+END_SRC
* End of files :noexport: ** End of files :noexport:
** Header *** Test
#+BEGIN_SRC C :comments link :tangle qmckl_memory.h #+BEGIN_SRC C :comments org :tangle test_qmckl_memory.c
#endif
#+END_SRC
** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_memory.c
return MUNIT_OK; return MUNIT_OK;
} }
#+END_SRC #+END_SRC
# -*- mode: org -*-
# vim: syntax=c