TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-06-30 00:44:52 +02:00
Code Issues Projects Releases Wiki Activity

Added polynomials

Browse Source
This commit is contained in:
Anthony Scemama 2020-10-25 15:02:37 +01:00
parent 9fde54922e
commit 5e9e74f743
6 changed files with 457 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Makefile
View File

@ -2,7 +2,7 @@ CC=gcc
CFLAGS=-fPIC -fexceptions -Wall -Werror -Wpedantic -Wextra -g
FC=gfortran
FFLAGS=-fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
FFLAGS=-fPIC -g -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant -Wuninitialized -fbacktrace -ffpe-trap=zero,overflow,underflow -finit-real=nan
LIBS=-lgfortran -lm
@ -25,7 +25,7 @@ doc:$(ORG_SOURCE_FILES)
./create_doc.sh $(ORG_SOURCE_FILES)
clean:
rm -f qmckl.h test_qmckl_* qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so
rm -f qmckl.h test_qmckl_* test_qmckl.c qmckl_*.f90 qmckl_*.c qmckl_*.o qmckl_*.h Makefile.generated libqmckl.so *.html
Makefile.generated: $(ORG_SOURCE_FILES) Makefile create_makefile.sh
./create_makefile.sh $(ORG_SOURCE_FILES)

10
src/README.org
View File

@ -104,6 +104,8 @@ rm ${nb}.md
produced C files should be =xxx.c= and =xxx.h= and the name of the
produced Fortran files should be =xxx.f90=
Arrays are in uppercase and scalars are in lowercase.
** Application programming interface
The application programming interface (API) is designed to be
@ -111,17 +113,17 @@ rm ${nb}.md
that the library will be easily usable in any language.
This implies that only the following data types are allowed in the API:
- 32-bit and 64-bit floats and arrays
- 32-bit and 64-bit integers and arrays
- 32-bit and 64-bit floats and arrays (=real= and =double=)
- 32-bit and 64-bit integers and arrays (=int32_t= and =int64_t=)
- Pointers should be represented as 64-bit integers (even on
32-bit architectures)
- ASCII strings are represented as a pointers to a character arrays
and terminated by a zero character (C convention).
# TODO : Link to repositories for bindings
To facilitate the use in other languages than C, we provide some
bindings in other languages in other repositories.
# TODO : Link to repositories for bindings
** Global state
@ -186,7 +188,6 @@ rm ${nb}.md
As QMCkl is a general purpose library, multiple algorithms should
be implemented adapted to different problem sizes.
* Rules for the API
- =stdint= should be used for integers (=int32_t=, =int64_t=)
@ -200,6 +201,7 @@ rm ${nb}.md
- [[./qmckl_memory.org][Memory management]]
- [[./qmckl_context.org][Context]]
- [[./qmckl_distance.org][Distance]]
- [[./qmckl_ao.org][Atomic orbitals]]
* Acknowledgments

1
src/qmckl.org
View File

@ -58,6 +58,7 @@ typedef int64_t qmckl_context ;
#include "qmckl_context.h"
#include "qmckl_distance.h"
#include "qmckl_ao.h"
#+END_SRC
* End of header

400
src/qmckl_ao.org Normal file
View File

@ -0,0 +1,400 @@
# -*- mode: org -*-
# 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
values, gradients and Laplacian of the atomic basis functions.
3 files are produced:
- a header file : =qmckl_ao.h=
- a source file : =qmckl_ao.f90=
- a test file : =test_qmckl_ao.c=
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h
#ifndef QMCKL_AO_H
#define QMCKL_AO_H
#include "qmckl_context.h"
#include "qmckl_distance.h"
#+END_SRC
*** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90
#+END_SRC
*** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c
#include <math.h>
#include "qmckl.h"
#include "munit.h"
MunitResult test_qmckl_ao() {
qmckl_context context;
context = qmckl_context_create();
#+END_SRC
* Polynomials
\[ P_l(\mathbf{r},\mathbf{R}_i) = (x-X_i)^a (y-Y_i)^b (z-Z_i)^c \]
** =qmckl_ao_powers=
Computes all the powers of the =n= input data up to the given
maximum value given in input for each of the $n$ points:
\[ P_{ij} = X_j^i \]
*** Arguments
| =context= | input | Global state |
| =n= | input | Number of values |
| =X(n)= | input | Array containing the input values |
| =LMAX(n)= | input | Array containing the maximum power for each value |
| =P(LDP,n)= | output | Array containing all the powers of $X$ |
| =LDP= | input | Leading dimension of array =P= |
*** Requirements
- =context= is not 0
- =n= > 0
- =X= is allocated with at least $n \times 8$ bytes
- =LMAX= is allocated with at least $n \times 4$ bytes
- =P= is allocated with at least $n \times \max_i \text{LMAX}_i \times 8$ bytes
- =LDP= >= $\max_i$ =LMAX[i]=
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h
qmckl_exit_code qmckl_ao_powers(qmckl_context context,
int64_t n,
double *X, int32_t *LMAX,
double *P, int64_t LDP);
#+END_SRC
*** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90
integer function qmckl_ao_powers_f(context, n, X, LMAX, P, ldp) result(info)
implicit none
integer*8 , intent(in) :: context
integer*8 , intent(in) :: n
real*8 , intent(in) :: X(n)
integer , intent(in) :: LMAX(n)
real*8 , intent(out) :: P(ldp,n)
integer*8 , intent(in) :: ldp
integer*8 :: i,j
info = 0
if (context == 0_8) then
info = -1
return
endif
if (LDP < MAXVAL(LMAX)) then
info = -2
return
endif
do j=1,n
P(1,j) = X(j)
do i=2,LMAX(j)
P(i,j) = P(i-1,j) * X(j)
end do
end do
end function qmckl_ao_powers_f
integer(c_int32_t) function qmckl_ao_powers(context, n, X, LMAX, P, ldp) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: n
real (c_double) , intent(in) :: X(n)
integer (c_int32_t) , intent(in) :: LMAX(n)
real (c_double) , intent(out) :: P(ldp,n)
integer (c_int64_t) , intent(in) , value :: ldp
integer, external :: qmckl_ao_powers_f
info = qmckl_ao_powers_f(context, n, X, LMAX, P, ldp)
end function qmckl_ao_powers
#+END_SRC
*** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c
{
int64_t n, LDP ;
int32_t *LMAX ;
double *X, *P ;
int i, j;
n = 100;
LDP = 10;
X = (double*) qmckl_malloc (context, n*sizeof(double));
LMAX = (int32_t*) qmckl_malloc (context, n*sizeof(int32_t));
P = (double*) qmckl_malloc (context, LDP*n*sizeof(double));
for (j=0 ; j<n ; j++) {
X[j] = -5. + 0.1 * (double) (j);
LMAX[j] = 1 + (j % 9);
}
munit_assert_int64(QMCKL_SUCCESS, ==,
qmckl_ao_powers(context, n, X, LMAX, P, LDP) );
for (j=0 ; j<n ; j++) {
for (i=0 ; i<LMAX[j] ; i++) {
munit_assert_double_equal( P[i+j*LDP], pow(X[j],i+1), 10 );
}
}
qmckl_free(X);
qmckl_free(P);
qmckl_free(LMAX);
}
#+END_SRC
** =qmckl_ao_polynomial_vgl=
Computes the value, gradient and Laplacian of the Polynomials for each
point given in input and for each center
*** Arguments
| =context= | input | Global state |
| =X(3)= | input | Array containing the coordinates of the points |
| =R(3)= | input | Array containing the x,y,z coordinates of the center |
| =lmax= | input | Maximum angular momentum |
| =n= | output | Number of computed polynomials |
| =L(LDL,n)= | output | Contains a,b,c for all =n= results |
| =LDL= | input | Leading dimension of =L= |
| =VGL(LDV,n)= | output | Value, gradients and Laplacian of the polynomials |
| =LDV= | input | Leading dimension of array =VGL= |
*** Requirements
- =context= is not 0
- =n= > 0
- =X= is allocated with at least $3 \times 8$ bytes
- =R= is allocated with at least $3 \times 8$ bytes
- =lmax= >= 0
- On output, =n= should be equal to (=lmax=+1)(=lmax=+2)(=lmax=+3)/6
- =L= is allocated with at least $3 \times n \times 4$ bytes
- =ldl= >= 3
- =VGL= is allocated with at least $5 \times n \times 8$ bytes
- =ldv= >= 5
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h
qmckl_exit_code qmckl_ao_polynomial_vgl(qmckl_context context,
double *X, double *R,
int32_t lmax, int64_t *n,
int32_t *L, int64_t ldl,
double *VGL, int64_t ldv);
#+END_SRC
*** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_ao.f90
integer function qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv) result(info)
implicit none
integer*8 , intent(in) :: context
real*8 , intent(in) :: X(3), R(3)
integer , intent(in) :: lmax
integer*8 , intent(out) :: n
integer , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6)
integer*8 , intent(in) :: ldl
real*8 , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6)
integer*8 , intent(in) :: ldv
integer*8 :: i,j
integer :: a,b,c,d
real*8 :: Y(3)
integer :: lmax_array(3)
real*8 :: pows(-2:lmax,3)
integer, external :: qmckl_ao_powers_f
info = 0
if (context == 0_8) then
info = -1
return
endif
n = (lmax+1)*(lmax+2)*(lmax+3)/6
if (ldl < 3) then
info = -2
return
endif
if (ldv < 5) then
info = -3
return
endif
do i=1,3
Y(i) = X(i) - R(i)
end do
pows(-2:-1,1:3) = 0.d0
pows(0,1:3) = 1.d0
lmax_array(1:3) = lmax
info = qmckl_ao_powers_f(context, 1_8, Y(1), (/lmax/), pows(1,1), size(pows,1,kind=8))
if (info /= 0) return
info = qmckl_ao_powers_f(context, 1_8, Y(2), (/lmax/), pows(1,2), size(pows,1,kind=8))
if (info /= 0) return
info = qmckl_ao_powers_f(context, 1_8, Y(3), (/lmax/), pows(1,3), size(pows,1,kind=8))
if (info /= 0) return
n=1
vgl(1:5,1:n) = 0.d0
l(1:3,n) = 0
vgl(1,n) = 1.d0
do d=1,lmax
do a=0,d
do b=0,d
do c=0,d
if (a+b+c == d) then
n = n+1
l(1,n) = a
l(2,n) = b
l(3,n) = c
vgl(1,n) = pows(a,1) * pows(b,2) * pows(c,3)
vgl(2,n) = dble(a) * pows(a-1,1) * pows(b ,2) * pows(c ,3)
vgl(3,n) = dble(b) * pows(a ,1) * pows(b-1,2) * pows(c ,3)
vgl(4,n) = dble(c) * pows(a ,1) * pows(b ,2) * pows(c-1,3)
vgl(5,n) = dble(a) * dble(a-1) * pows(a-2,1) * pows(b ,2) * pows(c ,3) &
+ dble(b) * dble(b-1) * pows(a ,1) * pows(b-2,2) * pows(c ,3) &
+ dble(c) * dble(c-1) * pows(a ,1) * pows(b ,2) * pows(c-2,3)
exit
end if
end do
end do
end do
end do
end function qmckl_ao_polynomial_vgl_f
integer(c_int32_t) function qmckl_ao_polynomial_vgl(context, X, R, lmax, n, L, ldl, VGL, ldv) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
real (c_double) , intent(in) :: X(3), R(3)
integer (c_int32_t) , intent(in) , value :: lmax
integer (c_int64_t) , intent(out) :: n
integer (c_int32_t) , intent(out) :: L(ldl,(lmax+1)*(lmax+2)*(lmax+3)/6)
integer (c_int64_t) , intent(in) , value :: ldl
real (c_double) , intent(out) :: VGL(ldv,(lmax+1)*(lmax+2)*(lmax+3)/6)
integer (c_int64_t) , intent(in) , value :: ldv
integer, external :: qmckl_ao_polynomial_vgl_f
info = qmckl_ao_polynomial_vgl_f(context, X, R, lmax, n, L, ldl, VGL, ldv)
end function qmckl_ao_polynomial_vgl
#+END_SRC
*** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c
{
#include <stdio.h>
double X[3] = { 1.1 , 2.2 , 3.3 };
double R[3] = { 0.1 , 1.2 , -2.3 };
double Y[3];
int32_t lmax = 4;
int64_t n = 0;
int64_t ldl = 3;
int64_t ldv = 100;
int32_t* L_mem;
int32_t* L[100];
double* VGL_mem;
double* VGL[100];
int j;
int d = (lmax+1)*(lmax+2)*(lmax+3)/6;
L_mem = (int32_t*) malloc(ldl*100*sizeof(int32_t));
VGL_mem = (double*) malloc(ldv*100*sizeof(double));
munit_assert_int64(QMCKL_SUCCESS, ==,
qmckl_ao_polynomial_vgl(context, X, R, lmax, &n, L_mem, ldl, VGL_mem, ldv) );
munit_assert_int64( n, ==, d );
for (j=0 ; j<n ; j++) {
L[j] = &L_mem[j*ldl];
VGL[j] = &VGL_mem[j*ldv];
}
Y[0] = X[0] - R[0];
Y[1] = X[1] - R[1];
Y[2] = X[2] - R[2];
for (j=0 ; j<n ; j++) {
munit_assert_int64( L[j][0], >=, 0 );
munit_assert_int64( L[j][1], >=, 0 );
munit_assert_int64( L[j][2], >=, 0 );
munit_assert_double_equal( VGL[j][0],
pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]), 10 );
if (L[j][0] < 1) {
munit_assert_double_equal( VGL[j][1], 0., 10);
} else {
munit_assert_double_equal( VGL[j][1],
L[j][0] * pow(Y[0],L[j][0]-1) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]), 10 );
}
if (L[j][1] < 1) {
munit_assert_double_equal( VGL[j][2], 0., 10);
} else {
munit_assert_double_equal( VGL[j][2],
L[j][1] * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]-1) * pow(Y[2],L[j][2]), 10 );
}
if (L[j][2] < 1) {
munit_assert_double_equal( VGL[j][3], 0., 10);
} else {
munit_assert_double_equal( VGL[j][3],
L[j][2] * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]-1), 10 );
}
double w = 0.;
if (L[j][0] > 1) w += L[j][0] * (L[j][0]-1) * pow(Y[0],L[j][0]-2) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]);
if (L[j][1] > 1) w += L[j][1] * (L[j][1]-1) * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]-2) * pow(Y[2],L[j][2]);
if (L[j][2] > 1) w += L[j][2] * (L[j][2]-1) * pow(Y[0],L[j][0]) * pow(Y[1],L[j][1]) * pow(Y[2],L[j][2]-2);
munit_assert_double_equal( VGL[j][4], w, 10 );
}
free(L_mem);
free(VGL_mem);
}
#+END_SRC
* TODO Gaussian basis functions
* TODO Slater basis functions
* End of files
*** Header
#+BEGIN_SRC C :comments link :tangle qmckl_ao.h
#endif
#+END_SRC
*** Test
#+BEGIN_SRC C :comments link :tangle test_qmckl_ao.c
if (qmckl_context_destroy(context) != QMCKL_SUCCESS)
return QMCKL_FAILURE;
return MUNIT_OK;
}
#+END_SRC

73
src/qmckl_distance.org
View File

@ -77,25 +77,24 @@ MunitResult test_qmckl_distance() {
*** Arguments
| =context= | input | Global state |
| =m= | input | Number of points in the first set |
| =n= | input | Number of points in the second set |
| =LDA= | input | Leading dimension of array =A= |
| =A= | input | Array containing the $3 \times m$ matrix $A$ |
| =LDB= | input | Leading dimension of array =B= |
| =B= | input | Array containing the $3 \times n$ matrix $B$ |
| =LDC= | input | Leading dimension of array =C= |
| =C= | output | Array containing the $m \times n$ matrix $C$ |
| =info= | output | exit status is zero upon success |
| =context= | input | Global state |
| =m= | input | Number of points in the first set |
| =n= | input | Number of points in the second set |
| =A(lda,3)= | input | Array containing the $m \times 3$ matrix $A$ |
| =lda= | input | Leading dimension of array =A= |
| =B(ldb,3)= | input | Array containing the $n \times 3$ matrix $B$ |
| =ldb= | input | Leading dimension of array =B= |
| =C(ldc,n)= | output | Array containing the $m \times n$ matrix $C$ |
| =ldc= | input | Leading dimension of array =C= |
*** Requirements
- =context= is not 0
- =m= > 0
- =n= > 0
- =LDA= >= m
- =LDB= >= n
- =LDC= >= m
- =lda= >= m
- =ldb= >= n
- =ldc= >= m
- =A= is allocated with at least $3 \times m \times 8$ bytes
- =B= is allocated with at least $3 \times n \times 8$ bytes
- =C= is allocated with at least $m \times n \times 8$ bytes
@ -104,28 +103,26 @@ MunitResult test_qmckl_distance() {
#+BEGIN_SRC C :comments link :tangle qmckl_distance.h
qmckl_exit_code qmckl_distance_sq(qmckl_context context,
int64_t m, int64_t n,
double *A, int64_t LDA,
double *B, int64_t LDB,
double *C, int64_t LDC);
double *A, int64_t lda,
double *B, int64_t ldb,
double *C, int64_t ldc);
#+END_SRC
*** Source
#+BEGIN_SRC f90 :comments link :tangle qmckl_distance.f90
integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
integer function qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC) result(info)
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: m, n
integer (c_int64_t) , intent(in) , value :: LDA
real (c_double) , intent(in) :: A(LDA,3)
integer (c_int64_t) , intent(in) , value :: LDB
real (c_double) , intent(in) :: B(LDB,3)
integer (c_int64_t) , intent(in) , value :: LDC
real (c_double) , intent(out) :: C(LDC,n)
integer*8 , intent(in) :: context
integer*8 , intent(in) :: m, n
integer*8 , intent(in) :: lda
real*8 , intent(in) :: A(lda,3)
integer*8 , intent(in) :: ldb
real*8 , intent(in) :: B(ldb,3)
integer*8 , intent(in) :: ldc
real*8 , intent(out) :: C(ldc,n)
integer (c_int64_t) :: i,j
real (c_double) :: x, y, z
integer*8 :: i,j
real*8 :: x, y, z
info = 0
@ -168,6 +165,24 @@ integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C,
end do
end do
end function qmckl_distance_sq_f
! C interface
integer(c_int32_t) function qmckl_distance_sq(context, m, n, A, LDA, B, LDB, C, LDC) &
bind(C) result(info)
use, intrinsic :: iso_c_binding
implicit none
integer (c_int64_t) , intent(in) , value :: context
integer (c_int64_t) , intent(in) , value :: m, n
integer (c_int64_t) , intent(in) , value :: lda
real (c_double) , intent(in) :: A(lda,3)
integer (c_int64_t) , intent(in) , value :: ldb
real (c_double) , intent(in) :: B(ldb,3)
integer (c_int64_t) , intent(in) , value :: ldc
real (c_double) , intent(out) :: C(ldc,n)
integer, external :: qmckl_distance_sq_f
info = qmckl_distance_sq_f(context, m, n, A, LDA, B, LDB, C, LDC)
end function qmckl_distance_sq
#+END_SRC

3
src/test_qmckl.org
View File

@ -23,6 +23,7 @@ grep BEGIN_SRC *.org | \
#+END_SRC
#+RESULTS: test-files
| test_qmckl_ao.c |
| test_qmckl_context.c |
| test_qmckl_distance.c |
| test_qmckl_memory.c |
@ -42,6 +43,7 @@ echo "#+END_SRC"
#+RESULTS:
#+NAME: headers
#+BEGIN_SRC C :tangle no
MunitResult test_qmckl_ao();
MunitResult test_qmckl_context();
MunitResult test_qmckl_distance();
MunitResult test_qmckl_memory();
@ -62,6 +64,7 @@ echo "#+END_SRC"
#+RESULTS:
#+NAME: calls
#+BEGIN_SRC C :tangle no
{ (char*) "test_qmckl_ao", test_qmckl_ao, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
{ (char*) "test_qmckl_context", test_qmckl_context, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
{ (char*) "test_qmckl_distance", test_qmckl_distance, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
{ (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},