** Context :PROPERTIES: :c: qmckl_context.c :c_test: test_qmckl_context.c :fh: qmckl_f.f90 :h: qmckl.h :END: This file is written in C because it is more natural to express the context in C than in Fortran. 2 files are produced: - a source file : =qmckl_context.c= - a test file : =test_qmckl_context.c= *** 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) #include "qmckl.h" #include "munit.h" MunitResult test_qmckl_context() { #+END_SRC *** Context 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. #+BEGIN_SRC C :comments org :tangle qmckl.h typedef int64_t qmckl_context ; #+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 "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_prim_num; 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. #+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_electron_struct * electron; struct qmckl_ao_basis_struct * ao_basis; // struct qmckl_mo_struct * mo; // struct qmckl_determinant_struct * det; /* Numerical precision */ uint32_t tag; 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 ***** 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 **** ~qmckl_context_check~ Checks if the domain pointed by the pointer is a valid context. Returns the input ~qmckl_context~ if the context is valid, 0 otherwise. #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_check(const qmckl_context context) ; #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_check(const qmckl_context context) { if (context == (qmckl_context) 0) return (qmckl_context) 0; const qmckl_context_struct * ctx = (qmckl_context_struct*) context; if (ctx->tag != VALID_TAG) return (qmckl_context) 0; return context; } #+END_SRC **** ~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 - Returns ~0~ upon failure to allocate the internal data structure #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_create(); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_create() { qmckl_context_struct* context = (qmckl_context_struct*) qmckl_malloc ((qmckl_context) 0, sizeof(qmckl_context_struct)); if (context == NULL) { return (qmckl_context) 0; } context->prev = NULL; context->ao_basis = NULL; context->precision = QMCKL_DEFAULT_PRECISION; context->range = QMCKL_DEFAULT_RANGE; context->tag = VALID_TAG; context->error = NULL; return (qmckl_context) context; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_create() bind(C) use, intrinsic :: iso_c_binding end function qmckl_context_create end interface #+END_SRC ***** Test :noexport: #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) context = qmckl_context_create(); munit_assert_int64( context, !=, (qmckl_context) 0); munit_assert_int64( qmckl_context_check(context), ==, context); #+END_SRC **** ~qmckl_context_copy~ This function makes a shallow copy of the current context. - Copying the 0-valued context returns 0 - On success, returns a pointer to the new context using the ~qmckl_context~ type - Returns 0 upon failure to allocate the internal data structure for the new context #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_copy(const qmckl_context context); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_copy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) { return (qmckl_context) 0; } qmckl_context_struct* old_context = (qmckl_context_struct*) checked_context; qmckl_context_struct* new_context = (qmckl_context_struct*) qmckl_malloc (context, sizeof(qmckl_context_struct)); if (new_context == NULL) { return (qmckl_context) 0; } new_context->prev = old_context; new_context->ao_basis = old_context->ao_basis; new_context->precision = old_context->precision; new_context->range = old_context->range; new_context->tag = VALID_TAG; new_context->error = old_context->error; return (qmckl_context) new_context; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_copy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_copy end interface #+END_SRC ***** Test :noexport: #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) new_context = qmckl_context_copy(context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int64(new_context, !=, context); munit_assert_int64(qmckl_context_check(new_context), ==, new_context); #+END_SRC **** ~qmckl_context_previous~ Returns the previous context - On success, returns the ancestor of the current context - Returns 0 for the initial context - Returns 0 for the 0-valued context #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_previous(const qmckl_context context); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_previous(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) { return (qmckl_context) 0; } const qmckl_context_struct* ctx = (qmckl_context_struct*) checked_context; return qmckl_context_check((qmckl_context) ctx->prev); } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_previous(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_previous end interface #+END_SRC ***** Test :noexport: #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) 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(context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_previous((qmckl_context) 0), ==, (qmckl_context) 0); #+END_SRC **** ~qmckl_context_destroy~ Destroys the current context, leaving the ancestors untouched. - Succeeds if the current context is properly destroyed - Fails otherwise - Fails if the 0-valued context is given in argument - Fails if the the pointer is not a valid context #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_destroy(qmckl_context context); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_destroy(const qmckl_context context) { const qmckl_context checked_context = qmckl_context_check(context); if (checked_context == (qmckl_context) 0) return QMCKL_FAILURE; qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; ctx->tag = INVALID_TAG; return qmckl_free(context,ctx); } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_destroy(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_destroy end interface #+END_SRC ***** Test :noexport: #+BEGIN_SRC C :tangle (org-entry-get nil "c_test" t) munit_assert_int64(qmckl_context_check(new_context), ==, new_context); munit_assert_int64(new_context, !=, (qmckl_context) 0); munit_assert_int32(qmckl_context_destroy(new_context), ==, QMCKL_SUCCESS); munit_assert_int64(qmckl_context_check(new_context), !=, new_context); munit_assert_int64(qmckl_context_check(new_context), ==, (qmckl_context) 0); munit_assert_int64(qmckl_context_destroy((qmckl_context) 0), ==, QMCKL_FAILURE); #+END_SRC **** Basis set For H_2 with the following basis set, #+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 4 3.258000E-01 5.039030E-01 5 1.027000E-01 3.834210E-01 S 1 1 3.258000E-01 1.000000E+00 S 1 1 1.027000E-01 1.000000E+00 P 1 1 1.407000E+00 1.000000E+00 P 1 1 3.880000E-01 1.000000E+00 D 1 1 1.057000E+00 1.0000000 #+END_EXAMPLE we have: #+BEGIN_EXAMPLE type = 'G' shell_num = 12 prim_num = 20 SHELL_CENTER = [1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2] SHELL_ANG_MOM = ['S', 'S', 'S', 'P', 'P', 'D', 'S', 'S', 'S', 'P', 'P', 'D'] SHELL_PRIM_NUM = [5, 1, 1, 1, 1, 1, 5, 1, 1, 1, 1, 1] prim_index = [1, 6, 7, 8, 9, 10, 11, 16, 17, 18, 19, 20] EXPONENT = [ 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, 1.407, 0.388, 1.057, 33.87, 5.095, 1.159, 0.3258, 0.1027, 0.3258, 0.1027, 1.407, 0.388, 1.057] 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 **** ~qmckl_context_update_ao_basis~ Updates the data describing the AO basis set into the context. | ~type~ | Gaussian or Slater | | ~shell_num~ | Number of shells | | ~prim_num~ | Total number of primitives | | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | | ~EXPONENT(prim_num)~ | Array of exponents | | ~COEFFICIENT(prim_num)~ | Array of coefficients | #+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_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, const double * EXPONENT , const double * COEFFICIENT); #+END_SRC ***** Source #+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_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, const double * EXPONENT , const double * COEFFICIENT) { int64_t i; /* Check input */ if (type != 'G' && type != 'S') return QMCKL_FAILURE; 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) { 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) { 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) { 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) { 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) { 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) { 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; for (i=0 ; ishell_center [i] = SHELL_CENTER [i]; basis->shell_ang_mom [i] = SHELL_ANG_MOM [i]; basis->shell_prim_num[i] = SHELL_PRIM_NUM[i]; basis->shell_factor [i] = SHELL_FACTOR [i]; } for (i=0 ; iexponent [i] = EXPONENT[i]; basis->coefficient[i] = COEFFICIENT[i]; } ctx->ao_basis = basis; return QMCKL_SUCCESS; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_update_ao_basis(context, & typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, COEFFICIENT) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context character(c_char) , intent(in), value :: typ integer (c_int64_t), intent(in), value :: shell_num integer (c_int64_t), intent(in), value :: prim_num integer (c_int64_t), intent(in) :: SHELL_CENTER(shell_num) integer (c_int32_t), intent(in) :: SHELL_ANG_MOM(shell_num) double precision , intent(in) :: SHELL_FACTOR(shell_num) integer (c_int64_t), intent(in) :: SHELL_PRIM_NUM(shell_num) integer (c_int64_t), intent(in) :: SHELL_PRIM_INDEX(shell_num) double precision , intent(in) :: EXPONENT(prim_num) double precision , intent(in) :: COEFFICIENT(prim_num) end function qmckl_context_update_ao_basis end interface #+END_SRC ***** TODO Test **** ~qmckl_context_set_ao_basis~ Sets the data describing the AO basis set into the context. | ~type~ | Gaussian or Slater | | ~shell_num~ | Number of shells | | ~prim_num~ | Total number of primitives | | ~SHELL_CENTER(shell_num)~ | Id of the nucleus on which the shell is centered | | ~SHELL_ANG_MOM(shell_num)~ | Id of the nucleus on which the shell is centered | | ~SHELL_FACTOR(shell_num)~ | Normalization factor for the shell | | ~SHELL_PRIM_NUM(shell_num)~ | Number of primitives in the shell | | ~SHELL_PRIM_INDEX(shell_num)~ | Address of the first primitive of the shelll in the ~EXPONENT~ array | | ~EXPONENT(prim_num)~ | Array of exponents | | ~COEFFICIENT(prim_num)~ | Array of coefficients | #+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_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, const double * EXPONENT , const double * COEFFICIENT); #+END_SRC ***** Source #+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_CENTER, const int32_t * SHELL_ANG_MOM, const double * SHELL_FACTOR, const int64_t * SHELL_PRIM_NUM, const int64_t * SHELL_PRIM_INDEX, const double * EXPONENT , const double * COEFFICIENT) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; 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) return 0; return new_context; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_set_ao_basis(context, & typ, shell_num, prim_num, SHELL_CENTER, SHELL_ANG_MOM, SHELL_FACTOR, & SHELL_PRIM_NUM, SHELL_PRIM_INDEX, EXPONENT, COEFFICIENT) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context character(c_char) , intent(in), value :: typ integer (c_int64_t), intent(in), value :: shell_num integer (c_int64_t), intent(in), value :: prim_num integer (c_int64_t), intent(in) :: SHELL_CENTER(shell_num) integer (c_int32_t), intent(in) :: SHELL_ANG_MOM(shell_num) double precision , intent(in) :: SHELL_FACTOR(shell_num) integer (c_int64_t), intent(in) :: SHELL_PRIM_NUM(shell_num) integer (c_int64_t), intent(in) :: SHELL_PRIM_INDEX(shell_num) double precision , intent(in) :: EXPONENT(prim_num) double precision , intent(in) :: COEFFICIENT(prim_num) end function qmckl_context_set_ao_basis end interface #+END_SRC ***** TODO Test **** Precision The following functions set and get the expected required precision and range. ~precision~ should be an integer between 2 and 53, and ~range~ should be an integer between 2 and 11. The setter functions functions return a new context as a 64-bit integer. The getter functions return the value, as a 32-bit integer. The update functions return ~QMCKL_SUCCESS~ or ~QMCKL_FAILURE~. **** ~qmckl_context_update_precision~ Modifies the parameter for the numerical precision in a given context. #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision) { if (precision < 2) return QMCKL_FAILURE; if (precision > 53) return QMCKL_FAILURE; qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; ctx->precision = precision; return QMCKL_SUCCESS; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_update_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context integer (c_int32_t), intent(in), value :: precision end function qmckl_context_update_precision end interface #+END_SRC ***** TODO Tests :noexport: **** ~qmckl_context_update_range~ Modifies the parameter for the numerical range in a given context. #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range) { if (range < 2) return QMCKL_FAILURE; if (range > 11) return QMCKL_FAILURE; qmckl_context_struct* ctx = (qmckl_context_struct*) context; if (ctx == NULL) return QMCKL_FAILURE; ctx->range = range; return QMCKL_SUCCESS; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_update_range(context, range) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context integer (c_int32_t), intent(in), value :: range end function qmckl_context_update_range end interface #+END_SRC ***** TODO Tests :noexport: **** ~qmckl_context_set_precision~ Returns a copy of the context with a different precision parameter. #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; if (qmckl_context_update_precision(new_context, precision) == QMCKL_FAILURE) return 0; return new_context; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_set_precision(context, precision) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context integer (c_int32_t), intent(in), value :: precision end function qmckl_context_set_precision end interface #+END_SRC ***** TODO Tests :noexport: **** ~qmckl_context_set_range~ Returns a copy of the context with a different precision parameter. #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) qmckl_context qmckl_context_set_range(const qmckl_context context, const int range); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) qmckl_context qmckl_context_set_range(const qmckl_context context, const int range) { qmckl_context new_context = qmckl_context_copy(context); if (new_context == 0) return 0; if (qmckl_context_update_range(new_context, range) == QMCKL_FAILURE) return 0; return new_context; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int64_t) function qmckl_context_set_range(context, range) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context integer (c_int32_t), intent(in), value :: range end function qmckl_context_set_range end interface #+END_SRC ***** TODO Tests :noexport: **** ~qmckl_context_get_precision~ Returns the value of the numerical precision in the context #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) int32_t qmckl_context_get_precision(const qmckl_context context); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) int qmckl_context_get_precision(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->precision; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_get_precision(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_precision end interface #+END_SRC ***** TODO Tests :noexport: **** ~qmckl_context_get_range~ Returns the value of the numerical range in the context #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) int32_t qmckl_context_get_range(const qmckl_context context); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) int qmckl_context_get_range(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return ctx->range; } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface integer (c_int32_t) function qmckl_context_get_range(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_range end interface #+END_SRC ***** TODO Tests :noexport: **** ~qmckl_context_get_epsilon~ Returns $\epsilon = 2^{1-n}$ where ~n~ is the precision #+BEGIN_SRC C :comments org :tangle (org-entry-get nil "h" t) double qmckl_context_get_epsilon(const qmckl_context context); #+END_SRC ***** Source #+BEGIN_SRC C :tangle (org-entry-get nil "c" t) double qmckl_context_get_epsilon(const qmckl_context context) { const qmckl_context_struct* ctx = (qmckl_context_struct*) context; return pow(2.0,(double) 1-ctx->precision); } #+END_SRC ***** Fortran interface #+BEGIN_SRC f90 :tangle (org-entry-get nil "fh" t) interface real (c_double) function qmckl_context_get_epsilon(context) bind(C) use, intrinsic :: iso_c_binding integer (c_int64_t), intent(in), value :: context end function qmckl_context_get_epsilon end interface #+END_SRC ***** TODO Tests :noexport: *** End of files :noexport: ***** Test #+BEGIN_SRC C :comments link :tangle (org-entry-get nil "c_test" t) return MUNIT_OK; } #+END_SRC # -*- mode: org -*- # vim: syntax=c