diff --git a/TODO.org b/TODO.org index 1fad144..b565b64 100644 --- a/TODO.org +++ b/TODO.org @@ -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. diff --git a/src/Makefile b/src/Makefile index 7f78a9b..f067945 100644 --- a/src/Makefile +++ b/src/Makefile @@ -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) diff --git a/src/README.org b/src/README.org index a27768a..67c0101 100644 --- a/src/README.org +++ b/src/README.org @@ -205,4 +205,3 @@ rm ${nb}.md * Documentation - diff --git a/src/merge_org.sh b/src/merge_org.sh index b4b2101..41f8a41 100755 --- a/src/merge_org.sh +++ b/src/merge_org.sh @@ -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 \ diff --git a/src/qmckl.org b/src/qmckl.org index ce5a3ce..985f848 100644 --- a/src/qmckl.org +++ b/src/qmckl.org @@ -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 <<>> 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 <<>> 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 #include -#include + +<> + #+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 diff --git a/src/qmckl_context.org b/src/qmckl_context.org index ee249ff..fc8f0da 100644 --- a/src/qmckl_context.org +++ b/src/qmckl_context.org @@ -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 +#include +#include #+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 <<>> 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 ; ishell_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 ; ishell_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 diff --git a/src/qmckl_error.org b/src/qmckl_error.org new file mode 100644 index 0000000..dda5996 --- /dev/null +++ b/src/qmckl_error.org @@ -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 +#include +#include +#include + #+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 <<>>, 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 diff --git a/src/qmckl_memory.org b/src/qmckl_memory.org index 02a4cec..d861c13 100644 --- a/src/qmckl_memory.org +++ b/src/qmckl_memory.org @@ -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 diff --git a/src/qmckl_precision.org b/src/qmckl_precision.org new file mode 100644 index 0000000..60c8fd0 --- /dev/null +++ b/src/qmckl_precision.org @@ -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 diff --git a/src/test_qmckl.org b/src/test_qmckl.org index 1489768..cc0f169 100644 --- a/src/test_qmckl.org +++ b/src/test_qmckl.org @@ -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" <>