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

Error handling

Browse Source
This commit is contained in:
Anthony Scemama 2021-03-05 03:45:30 +01:00
parent 6f2adf2921
commit 56f5d9d56d
10 changed files with 451 additions and 160 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
TODO.org
View File

@ -16,3 +16,6 @@ context.
* Complex numbers
* Adjustable number for derivatives (1,2,3)
* Put pictures
* Make the Makefile part of the documented code ?
* Put the data-flow graph in the code.

4
src/Makefile
View File

@ -60,7 +60,7 @@ 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
Makefile.generated: Makefile create_makefile.sh $(ORG_SOURCE_FILES)
./merge_org.sh
./create_makefile.sh $(MERGED_ORG)
./merge_org.sh
./create_makefile.sh $(MERGED_ORG)
rm $(MERGED_ORG)

1
src/README.org
View File

@ -205,4 +205,3 @@ rm ${nb}.md
* Documentation

4
src/merge_org.sh
View File

@ -2,8 +2,10 @@
for i in README.org \
qmckl.org \
qmckl_memory.org \
qmckl_context.org \
qmckl_error.org \
qmckl_precision.org \
qmckl_memory.org \
qmckl_distance.org \
qmckl_ao.org \
qmckl_footer.org \

62
src/qmckl.org
View File

@ -1,18 +1,30 @@
** =qmckl.h= header file
This file produces the =qmckl.h= header file, which is to be included
when qmckl functions are used.
The =qmckl.h= header file has to be included in <<<C>>> codes when
QMCkl functions are used:
#+BEGIN_SRC C :tangle none
#include "qmckl.h"
#+END_SRC f90
We also create here the =qmckl_f.f90= which is the Fortran interface file.
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
use qmckl
#+END_SRC f90
*** Top of header files :noexport:
#+BEGIN_SRC C :tangle qmckl.h
#+BEGIN_SRC C :tangle qmckl.h :noweb yes
#ifndef QMCKL_H
#define QMCKL_H
#include <stdlib.h>
#include <stdint.h>
#include <math.h>
<<type-exit-code>>
#+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90
@ -22,43 +34,3 @@ module qmckl
The bottoms of the files are located in the [[qmckl_footer.org]] file.
*** Constants
**** Success/failure
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=.
#+BEGIN_SRC C :comments org :tangle qmckl.h
#define QMCKL_SUCCESS 0
#define QMCKL_FAILURE 1
typedef int32_t qmckl_exit_code;
typedef int64_t qmckl_context ;
#+END_SRC
#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
integer, parameter :: QMCKL_SUCCESS = 0
integer, parameter :: QMCKL_FAILURE = 0
#+END_SRC
**** Precision-related constants
Controlling numerical precision enables optimizations. Here, the
default parameters determining the target numerical precision and
range are defined.
#+BEGIN_SRC C :comments org :tangle qmckl.h
#define QMCKL_DEFAULT_PRECISION 53
#define QMCKL_DEFAULT_RANGE 11
#+END_SRC
#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
integer, parameter :: QMCKL_DEFAULT_PRECISION = 53
integer, parameter :: QMCKL_DEFAULT_RANGE = 11
#+END_SRC
# -*- mode: org -*-
# vim: syntax=c

299
src/qmckl_context.org
View File

@ -6,7 +6,6 @@
:h: qmckl.h
:END:
This file is written in C because it is more natural to express the
context in C than in Fortran.
@ -17,6 +16,9 @@
*** Headers :noexport:
#+BEGIN_SRC C :tangle (org-entry-get nil "c" t)
#include "qmckl.h"
#include <math.h>
#include <string.h>
#include <assert.h>
#+END_SRC
#+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t)
@ -25,54 +27,71 @@
MunitResult test_qmckl_context() {
#+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
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.
A value of ~0~ for the context is equivalent to a ~NULL~ pointer.
# The following code block should be kept to insert comments into
# the qmckl.h file
#+BEGIN_SRC C :comments org :tangle qmckl.h
typedef int64_t qmckl_context ;
#+END_SRC
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) :export none
#+END_SRC
**** Data for error handling
We define here the the data structure containing the strings
necessary for error handling.
#+BEGIN_SRC C :comments org :tangle qmckl.h
#define QMCKL_MAX_FUN_LEN 256
#define QMCKL_MAX_MSG_LEN 1024
typedef struct qmckl_error_struct {
qmckl_exit_code exit_code;
char function[QMCKL_MAX_FUN_LEN];
char message [QMCKL_MAX_MSG_LEN];
} qmckl_error_struct;
#+END_SRC
**** Basis set data structure
Data structure for the info related to the atomic orbitals
basis set.
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "c" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
typedef struct qmckl_ao_basis_struct {
int64_t shell_num;
int64_t prim_num;
int64_t * shell_center;
int32_t * shell_ang_mom;
double * shell_factor;
double * exponent ;
double * coefficient ;
int64_t shell_num;
int64_t prim_num;
int64_t * shell_center;
int32_t * shell_ang_mom;
double * shell_factor;
double * exponent ;
double * coefficient ;
int64_t * shell_prim_num;
char type;
char type;
} qmckl_ao_basis_struct;
#+END_SRC
**** Source
The tag is used internally to check if the memory domain pointed
by a pointer is a valid context.
***** Source
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "c" t)
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 (org-entry-get nil "h" t)
typedef struct qmckl_context_struct {
struct qmckl_context_struct * prev;
/* Molecular system */
// struct qmckl_nucleus_struct * nucleus;
// struct qmckl_nucleus_struct * nucleus;
// struct qmckl_electron_struct * electron;
struct qmckl_ao_basis_struct * ao_basis;
// struct qmckl_mo_struct * mo;
@ -83,17 +102,92 @@ typedef struct qmckl_context_struct {
int32_t precision;
int32_t range;
/* Error handling */
struct qmckl_error_struct * error;
} qmckl_context_struct;
#define VALID_TAG 0xBEEFFACE
#define INVALID_TAG 0xDEADBEEF
#+END_SRC
**** ~qmckl_context_update_error~
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_exit_code
qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message);
#+END_SRC
**** Test :noexport:
#+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t)
***** Source
#+BEGIN_SRC C :tangle (org-entry-get nil "c" t)
qmckl_exit_code
qmckl_context_update_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message)
{
assert (context != 0);
assert (function != NULL);
assert (message != NULL);
assert (exit_code > 0);
assert (exit_code < QMCKL_INVALID_EXIT_CODE);
qmckl_context_struct* ctx = (qmckl_context_struct*) context;
if (ctx == NULL) return QMCKL_FAILURE;
if (ctx->error != NULL) {
free(ctx->error);
ctx->error = NULL;
}
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->message, message);
ctx->error = error;
return QMCKL_SUCCESS;
}
#+END_SRC
***** TODO Test
**** ~qmckl_context_set_error~
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context
qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message);
#+END_SRC
***** Source
#+BEGIN_SRC C :tangle (org-entry-get nil "c" t)
qmckl_context
qmckl_context_set_error(qmckl_context context, const qmckl_exit_code exit_code, const char* function, const char* message)
{
assert (context != 0);
assert (function != NULL);
assert (message != NULL);
assert (exit_code > 0);
assert (exit_code < QMCKL_INVALID_EXIT_CODE);
qmckl_context new_context = qmckl_context_copy(context);
if (new_context == 0) return context;
if (qmckl_context_update_error(new_context, exit_code,
function, message) != QMCKL_SUCCESS) {
return context;
}
return new_context;
}
#+END_SRC
***** TODO Test
***** Test :noexport:
#+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t)
qmckl_context context;
qmckl_context new_context;
#+END_SRC
#+END_SRC
**** ~qmckl_context_check~
@ -102,7 +196,7 @@ qmckl_context new_context;
Returns the input ~qmckl_context~ if the context is valid, 0
otherwise.
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context qmckl_context_check(const qmckl_context context) ;
#+END_SRC
@ -126,7 +220,7 @@ qmckl_context qmckl_context_check(const qmckl_context context) {
- 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 (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context qmckl_context_create();
#+END_SRC
@ -145,6 +239,7 @@ qmckl_context qmckl_context_create() {
context->precision = QMCKL_DEFAULT_PRECISION;
context->range = QMCKL_DEFAULT_RANGE;
context->tag = VALID_TAG;
context->error = NULL;
return (qmckl_context) context;
}
@ -174,7 +269,7 @@ munit_assert_int64( qmckl_context_check(context), ==, context);
- Returns 0 upon failure to allocate the internal data structure
for the new context
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context qmckl_context_copy(const qmckl_context context);
#+END_SRC
@ -190,7 +285,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) {
qmckl_context_struct* old_context = (qmckl_context_struct*) checked_context;
qmckl_context_struct* new_context =
qmckl_context_struct* new_context =
(qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct));
if (new_context == NULL) {
return (qmckl_context) 0;
@ -201,6 +296,7 @@ qmckl_context qmckl_context_copy(const qmckl_context context) {
new_context->precision = old_context->precision;
new_context->range = old_context->range;
new_context->tag = VALID_TAG;
new_context->error = old_context->error;
return (qmckl_context) new_context;
}
@ -232,7 +328,7 @@ munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
- Returns 0 for the initial context
- Returns 0 for the 0-valued context
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context qmckl_context_previous(const qmckl_context context);
#+END_SRC
@ -276,7 +372,7 @@ munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context
- 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 (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_exit_code qmckl_context_destroy(qmckl_context context);
#+END_SRC
@ -291,8 +387,7 @@ qmckl_exit_code qmckl_context_destroy(const qmckl_context context) {
if (ctx == NULL) return QMCKL_FAILURE;
ctx->tag = INVALID_TAG;
qmckl_free(ctx);
return QMCKL_SUCCESS;
return qmckl_free(context,ctx);
}
#+END_SRC
@ -316,16 +411,16 @@ munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0);
munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE);
#+END_SRC
*** Basis set
**** Basis set
For H_2 with the following basis set,
For H_2 with the following basis set,
#+BEGIN_EXAMPLE
#+BEGIN_EXAMPLE
HYDROGEN
S 5
1 3.387000E+01 6.068000E-03
2 5.095000E+00 4.530800E-02
3 1.159000E+00 2.028220E-01
3 1.159000E+00 2.028220E-01
4 3.258000E-01 5.039030E-01
5 1.027000E-01 3.834210E-01
S 1
@ -338,11 +433,11 @@ P 1
1 3.880000E-01 1.000000E+00
D 1
1 1.057000E+00 1.0000000
#+END_EXAMPLE
#+END_EXAMPLE
we have:
we have:
#+BEGIN_EXAMPLE
#+BEGIN_EXAMPLE
type = 'G'
shell_num = 12
prim_num = 20
@ -356,7 +451,7 @@ EXPONENT = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027,
COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421,
1.0, 1.0, 1.0, 1.0, 1.0, 0.006068, 0.045308, 0.202822,
0.503903, 0.383421, 1.0, 1.0, 1.0, 1.0, 1.0]
#+END_EXAMPLE
#+END_EXAMPLE
**** ~qmckl_context_update_ao_basis~
@ -373,10 +468,10 @@ COEFFICIENT = [ 0.006068, 0.045308, 0.202822, 0.503903, 0.383421,
| ~EXPONENT(prim_num)~ | Array of exponents |
| ~COEFFICIENT(prim_num)~ | Array of coefficients |
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
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_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,
@ -387,7 +482,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type
#+BEGIN_SRC C :tangle (org-entry-get nil "c" t)
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_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,
@ -402,84 +497,84 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type
if (shell_num <= 0) return QMCKL_FAILURE;
if (prim_num <= 0) return QMCKL_FAILURE;
if (prim_num < shell_num) return QMCKL_FAILURE;
for (i=0 ; i<shell_num ; i++) {
if (SHELL_CENTER[i] <= 0) return QMCKL_FAILURE;
if (SHELL_PRIM_NUM[i] <= 0) return QMCKL_FAILURE;
if (SHELL_ANG_MOM[i] < 0) return QMCKL_FAILURE;
if (SHELL_PRIM_INDEX[i] < 0) return QMCKL_FAILURE;
}
for (i=0 ; i<prim_num ; i++) {
if (EXPONENT[i] <= 0) return QMCKL_FAILURE;
}
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;
/* Memory allocations */
basis->shell_center = (int64_t*) malloc (shell_num * sizeof(int64_t));
if (basis->shell_center == NULL) {
free(basis);
qmckl_free(context, basis);
return QMCKL_FAILURE;
}
basis->shell_ang_mom = (int32_t*) malloc (shell_num * sizeof(int32_t));
if (basis->shell_ang_mom == NULL) {
free(basis->shell_center);
free(basis);
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));
if (basis->shell_prim_num == NULL) {
free(basis->shell_ang_mom);
free(basis->shell_center);
free(basis);
qmckl_free(context, basis->shell_ang_mom);
qmckl_free(context, basis->shell_center);
qmckl_free(context, basis);
return QMCKL_FAILURE;
}
basis->shell_factor = (double *) malloc (shell_num * sizeof(double ));
if (basis->shell_factor == NULL) {
free(basis->shell_prim_num);
free(basis->shell_ang_mom);
free(basis->shell_center);
free(basis);
qmckl_free(context, basis->shell_prim_num);
qmckl_free(context, basis->shell_ang_mom);
qmckl_free(context, basis->shell_center);
qmckl_free(context, basis);
return QMCKL_FAILURE;
}
basis->exponent = (double *) malloc (prim_num * sizeof(double ));
if (basis->exponent == NULL) {
free(basis->shell_factor);
free(basis->shell_prim_num);
free(basis->shell_ang_mom);
free(basis->shell_center);
free(basis);
qmckl_free(context, basis->shell_factor);
qmckl_free(context, basis->shell_prim_num);
qmckl_free(context, basis->shell_ang_mom);
qmckl_free(context, basis->shell_center);
qmckl_free(context, basis);
return QMCKL_FAILURE;
}
basis->coefficient = (double *) malloc (prim_num * sizeof(double ));
if (basis->coefficient == NULL) {
free(basis->exponent);
free(basis->shell_factor);
free(basis->shell_prim_num);
free(basis->shell_ang_mom);
free(basis->shell_center);
free(basis);
qmckl_free(context, basis->exponent);
qmckl_free(context, basis->shell_factor);
qmckl_free(context, basis->shell_prim_num);
qmckl_free(context, basis->shell_ang_mom);
qmckl_free(context, basis->shell_center);
qmckl_free(context, basis);
return QMCKL_FAILURE;
}
/* Assign data */
basis->type = type;
basis->shell_num = shell_num;
basis->prim_num = prim_num;
basis->prim_num = prim_num;
for (i=0 ; i<shell_num ; i++) {
basis->shell_center [i] = SHELL_CENTER [i];
@ -497,7 +592,7 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type
return QMCKL_SUCCESS;
}
#+END_SRC
***** Fortran interface
#+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t)
interface
@ -537,10 +632,10 @@ qmckl_context_update_ao_basis(qmckl_context context , const char type
| ~EXPONENT(prim_num)~ | Array of exponents |
| ~COEFFICIENT(prim_num)~ | Array of coefficients |
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context
qmckl_context_set_ao_basis(const qmckl_context context , const char type,
const int64_t shell_num , const int64_t prim_num,
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,
@ -551,7 +646,7 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ
#+BEGIN_SRC C :tangle (org-entry-get nil "c" t)
qmckl_context
qmckl_context_set_ao_basis(const qmckl_context context , const char type,
const int64_t shell_num , const int64_t prim_num,
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,
@ -561,8 +656,8 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ
qmckl_context new_context = qmckl_context_copy(context);
if (new_context == 0) return 0;
if (qmckl_context_update_ao_basis(context, type, shell_num, prim_num,
SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR,
if (qmckl_context_update_ao_basis(new_context, type, shell_num, prim_num,
SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR,
SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT,
COEFFICIENT
) == QMCKL_FAILURE)
@ -571,7 +666,7 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ
return new_context;
}
#+END_SRC
***** Fortran interface
#+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t)
interface
@ -596,20 +691,20 @@ qmckl_context_set_ao_basis(const qmckl_context context , const char typ
***** TODO Test
*** Precision
**** 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 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~.
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 (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision);
#+END_SRC
@ -642,7 +737,7 @@ qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, cons
***** TODO Tests :noexport:
**** ~qmckl_context_update_range~
Modifies the parameter for the numerical range in a given context.
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range);
#+END_SRC
@ -675,7 +770,7 @@ qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const in
***** TODO Tests :noexport:
**** ~qmckl_context_set_precision~
Returns a copy of the context with a different precision parameter.
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision);
#+END_SRC
@ -685,7 +780,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int
qmckl_context new_context = qmckl_context_copy(context);
if (new_context == 0) return 0;
if (qmckl_context_update_precision(context, precision) == QMCKL_FAILURE) return 0;
if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0;
return new_context;
}
@ -705,7 +800,7 @@ qmckl_context qmckl_context_set_precision(const qmckl_context context, const int
***** TODO Tests :noexport:
**** ~qmckl_context_set_range~
Returns a copy of the context with a different precision parameter.
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
qmckl_context qmckl_context_set_range(const qmckl_context context, const int range);
#+END_SRC
@ -715,7 +810,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran
qmckl_context new_context = qmckl_context_copy(context);
if (new_context == 0) return 0;
if (qmckl_context_update_range(context, range) == QMCKL_FAILURE) return 0;
if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0;
return new_context;
}
@ -736,7 +831,7 @@ qmckl_context qmckl_context_set_range(const qmckl_context context, const int ran
**** ~qmckl_context_get_precision~
Returns the value of the numerical precision in the context
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
int32_t qmckl_context_get_precision(const qmckl_context context);
#+END_SRC
@ -761,7 +856,7 @@ int qmckl_context_get_precision(const qmckl_context context) {
***** TODO Tests :noexport:
**** ~qmckl_context_get_range~
Returns the value of the numerical range in the context
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
int32_t qmckl_context_get_range(const qmckl_context context);
#+END_SRC
@ -787,7 +882,7 @@ int qmckl_context_get_range(const qmckl_context context) {
**** ~qmckl_context_get_epsilon~
Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
#+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t)
double qmckl_context_get_epsilon(const qmckl_context context);
#+END_SRC
@ -811,7 +906,7 @@ double qmckl_context_get_epsilon(const qmckl_context context) {
***** TODO Tests :noexport:
*** End of files :noexport:
@ -821,7 +916,7 @@ return MUNIT_OK;
}
#+END_SRC
# -*- mode: org -*-
# vim: syntax=c

193
src/qmckl_error.org Normal file
View File

@ -0,0 +1,193 @@
# This file is part of the qmckl.h file
** Error handling
:PROPERTIES:
:c: qmckl_error.c
:c_test: test_qmckl_error.c
:fh: qmckl_f.f90
:h: qmckl.h
:END:
This file is written in C because it is more natural to express the
error handling in C than in Fortran.
2 files are produced:
- a source file : =qmckl_error.c=
- a test file : =test_qmckl_error.c=
*** Headers :noexport:
#+BEGIN_SRC C :tangle (org-entry-get nil "c" t)
#include "qmckl.h"
#include <math.h>
#include <string.h>
#include <errno.h>
#include <assert.h>
#+END_SRC
#+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t)
#include "qmckl.h"
#include "munit.h"
MunitResult test_qmckl_error() {
#+END_SRC
*** Error handling
The library should never make the calling programs abort, nor
perform any input/output operations. This decision has to be taken
by the developer of the code calling the library.
All the functions return with an <<<exit code>>>, defined as
#+NAME: type-exit-code
#+BEGIN_SRC C :comments org :tangle qmckl.h
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
the library fails to complete the requested task, an appropriate
error code is returned to the program.
Here is the complete list of exit codes.
#+NAME: table-exit-codes
| ~QMCKL_SUCCESS~ | 0 |
| ~QMCKL_INVALID_ARG_1~ | 1 |
| ~QMCKL_INVALID_ARG_2~ | 2 |
| ~QMCKL_INVALID_ARG_3~ | 3 |
| ~QMCKL_INVALID_ARG_4~ | 4 |
| ~QMCKL_INVALID_ARG_5~ | 5 |
| ~QMCKL_INVALID_ARG_6~ | 6 |
| ~QMCKL_INVALID_ARG_7~ | 7 |
| ~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 |
# 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
""" This script generates the C and Fortran constants for the error
codes from the org-mode table.
"""
result = [ "#+BEGIN_SRC C :comments org :tangle qmckl.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 qmckl_f.f90" ]
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 qmckl.h
#define QMCKL_SUCCESS 0
#define QMCKL_INVALID_ARG_1 1
#define QMCKL_INVALID_ARG_2 2
#define QMCKL_INVALID_ARG_3 3
#define QMCKL_INVALID_ARG_4 4
#define QMCKL_INVALID_ARG_5 5
#define QMCKL_INVALID_ARG_6 6
#define QMCKL_INVALID_ARG_7 7
#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
#+END_SRC
#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
integer, parameter :: QMCKL_SUCCESS = 0
integer, parameter :: QMCKL_INVALID_ARG_1 = 1
integer, parameter :: QMCKL_INVALID_ARG_2 = 2
integer, parameter :: QMCKL_INVALID_ARG_3 = 3
integer, parameter :: QMCKL_INVALID_ARG_4 = 4
integer, parameter :: QMCKL_INVALID_ARG_5 = 5
integer, parameter :: QMCKL_INVALID_ARG_6 = 6
integer, parameter :: QMCKL_INVALID_ARG_7 = 7
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
#+END_SRC
:end:
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 qmckl.h
qmckl_exit_code qmckl_failwith(qmckl_context context,
const qmckl_exit_code exit_code,
const char* function,
const char* message) ;
#+END_SRC
#+BEGIN_SRC C :comments org :tangle qmckl_error.c
qmckl_exit_code qmckl_failwith(qmckl_context context,
const qmckl_exit_code exit_code,
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);
context = qmckl_context_set_error(context, exit_code, function, message);
return exit_code;
}
#+END_SRC
For example, this function can be used as
#+BEGIN_SRC C :tangle no
if (x < 0) {
return qmckl_failwith(context,
QMCKL_INVALID_ARG_2,
"qmckl_function",
"Expected x >= 0");
}
#+END_SRC
# To decode the error messages, the <<<~qmckl_strerror~>>> converts an
# error code into a string.
*** End of files :noexport:
***** Test
#+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t)
return MUNIT_OK;
}
#+END_SRC
# -*- mode: org -*-
# vim: syntax=c
# -*- mode: org -*-
# vim: syntax=c

22
src/qmckl_memory.org
View File

@ -67,33 +67,39 @@ munit_assert_int(a[2], ==, 3);
*** ~qmckl_free~
The context is passed, in case some important information has been
stored related to memory allocation and needs to be updated.
#+BEGIN_SRC C :tangle qmckl.h
void* qmckl_free(void *ptr);
qmckl_exit_code qmckl_free(qmckl_context context, void *ptr);
#+END_SRC
#+BEGIN_SRC f90 :tangle qmckl_f.f90
interface
type (c_ptr) function qmckl_free (ptr) bind(C)
integer (c_int32_t) function qmckl_free (context, ptr) bind(C)
use, intrinsic :: iso_c_binding
integer (c_int64_t), intent(in), value :: context
type (c_ptr), intent(in), value :: ptr
end function qmckl_free
end interface
#+END_SRC
**** Source
#+BEGIN_SRC C :tangle qmckl_memory.c
void* qmckl_free(void *ptr) {
assert (ptr != NULL);
qmckl_exit_code qmckl_free(qmckl_context context, void *ptr) {
if (context == 0) return QMCKL_INVALID_ARG_1;
if (ptr == NULL) return QMCKL_INVALID_ARG_2;
free(ptr);
return NULL;
return QMCKL_SUCCESS;
}
#+END_SRC
**** Test :noexport:
#+BEGIN_SRC C :tangle test_qmckl_memory.c
munit_assert(a != NULL);
a = qmckl_free(a);
munit_assert(a == NULL);
qmckl_exit_code rc;
rc = qmckl_free( (qmckl_context) 1, a);
munit_assert(rc == QMCKL_SUCCESS);
#+END_SRC

21
src/qmckl_precision.org Normal file
View File

@ -0,0 +1,21 @@
# This file is part of the qmckl.h file
*** Multi-precision related constants
Controlling numerical precision enables optimizations. Here, the
default parameters determining the target numerical precision and
range are defined.
#+BEGIN_SRC C :comments org :tangle qmckl.h
#define QMCKL_DEFAULT_PRECISION 53
#define QMCKL_DEFAULT_RANGE 11
#+END_SRC
#+BEGIN_SRC f90 :comments org :tangle qmckl_f.f90
integer, parameter :: QMCKL_DEFAULT_PRECISION = 53
integer, parameter :: QMCKL_DEFAULT_RANGE = 11
#+END_SRC
# -*- mode: org -*-
# vim: syntax=c

2
src/test_qmckl.org
View File

@ -63,7 +63,7 @@ echo "#+END_SRC"
{ (char*) "test_qmckl_memory", test_qmckl_memory, NULL,NULL,MUNIT_TEST_OPTION_NONE,NULL},
#+END_SRC
#+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c
#+BEGIN_SRC C :comments link :noweb yes :tangle test_qmckl.c
#include "qmckl.h"
#include "munit.h"
<<headers>>