#+TITLE: Nucleus #+SETUPFILE: ../tools/theme.setup #+INCLUDE: ../tools/lib.org All the data relative to the molecular geometry is described here. * Headers :noexport: #+begin_src elisp :noexport :results none ( org-babel-lob-ingest "../tools/lib.org") #+end_src #+begin_src c :tangle (eval h_private_type) #ifndef QMCKL_NUCLEUS_HPT #define QMCKL_NUCLEUS_HPT #include #+end_src #+begin_src c :tangle (eval c_test) :noweb yes #include "qmckl.h" #include #include #include #ifdef HAVE_CONFIG_H #include "config.h" #endif #include "chbrclf.h" int main() { qmckl_context context; context = qmckl_context_create(); #+end_src #+begin_src c :tangle (eval c) #ifdef HAVE_CONFIG_H #include "config.h" #endif #ifdef HAVE_STDINT_H #include #elif HAVE_INTTYPES_H #include #endif #include #include #include #include #include #include #include "qmckl.h" #include "qmckl_context_private_type.h" #include "qmckl_memory_private_type.h" #include "qmckl_memory_private_func.h" #include "qmckl_nucleus_private_func.h" #+end_src * Context The following data stored in the context: | ~uninitialized~ | int32_t | Keeps bit set for uninitialized data | | ~num~ | int64_t | Total number of nuclei | | ~provided~ | bool | If true, ~nucleus~ is valid | | ~charge~ | double[num] | Nuclear charges | | ~coord~ | double[3][num] | Nuclear coordinates, in transposed format | | ~nn_distance~ | double[num][num] | Nucleus-nucleus distances | | ~nn_distance_date~ | int64_t | Date when Nucleus-nucleus distances were computed | | ~nn_distance_rescaled~ | double[num][num] | Nucleus-nucleus rescaled distances | | ~nn_distance_rescaled_date~ | int64_t | Date when Nucleus-nucleus rescaled distances were computed | | ~repulsion~ | double | Nuclear repulsion energy | | ~repulsion_date~ | int64_t | Date when the nuclear repulsion energy was computed | | ~rescale_factor_kappa~ | double | The distance scaling factor | ** Data structure #+begin_src c :comments org :tangle (eval h_private_type) typedef struct qmckl_nucleus_struct { int64_t num; int64_t repulsion_date; int64_t nn_distance_date; int64_t nn_distance_rescaled_date; double* coord; double* charge; double* nn_distance; double* nn_distance_rescaled; double repulsion; double rescale_factor_kappa; int32_t uninitialized; bool provided; } qmckl_nucleus_struct; #+end_src The ~uninitialized~ integer contains one bit set to one for each initialization function which has not been called. It becomes equal to zero after all initialization functions have been called. The struct is then initialized and ~provided == true~. ** Access functions #+begin_src c :comments org :tangle (eval h_func) :exports none qmckl_exit_code qmckl_get_nucleus_num (const qmckl_context context, int64_t* const num); qmckl_exit_code qmckl_get_nucleus_charge (const qmckl_context context, double* const charge); qmckl_exit_code qmckl_get_nucleus_kappa (const qmckl_context context, double* const rescale_factor_kappa); qmckl_exit_code qmckl_get_nucleus_coord (const qmckl_context context, const char transp, double* const coord); #+end_src #+NAME:post #+begin_src c :exports none if ( (ctx->nucleus.uninitialized & mask) != 0) { return NULL; } #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_get_nucleus_num (const qmckl_context context, int64_t* const num) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_INVALID_CONTEXT; } if (num == NULL) { return qmckl_failwith( context, QMCKL_INVALID_ARG_2, "qmckl_get_nucleus_num", "num is a null pointer"); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); int32_t mask = 1 << 0; if ( (ctx->nucleus.uninitialized & mask) != 0) { *num = (int64_t) 0; return qmckl_failwith( context, QMCKL_NOT_PROVIDED, "qmckl_get_nucleus_num", "nucleus data is not provided"); } assert (ctx->nucleus.num >= (int64_t) 0); ,*num = ctx->nucleus.num; return QMCKL_SUCCESS; } qmckl_exit_code qmckl_get_nucleus_charge (const qmckl_context context, double* const charge) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_INVALID_CONTEXT; } if (charge == NULL) { return qmckl_failwith( context, QMCKL_INVALID_ARG_2, "qmckl_get_nucleus_charge", "charge is a null pointer"); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); int32_t mask = 1 << 1; if ( (ctx->nucleus.uninitialized & mask) != 0) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, "qmckl_get_nucleus_charge", "nucleus data is not provided"); } assert (ctx->nucleus.charge != NULL); int64_t nucl_num = ctx->nucleus.num; memcpy(charge, ctx->nucleus.charge, nucl_num*sizeof(double)); return QMCKL_SUCCESS; } qmckl_exit_code qmckl_get_nucleus_kappa (const qmckl_context context, double* const rescale_factor_kappa) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_INVALID_CONTEXT; } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); int32_t mask = 1 << 2; if ( (ctx->nucleus.uninitialized & mask) != 0) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, "qmckl_get_nucleus_kappa", "nucleus data is not provided"); } (*rescale_factor_kappa) = ctx->nucleus.rescale_factor_kappa; return QMCKL_SUCCESS; } qmckl_exit_code qmckl_get_nucleus_coord (const qmckl_context context, const char transp, double* const coord) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_INVALID_CONTEXT; } if (transp != 'N' && transp != 'T') { return qmckl_failwith( context, QMCKL_INVALID_ARG_2, "qmckl_get_nucleus_coord", "transp should be 'N' or 'T'"); } if (coord == NULL) { return qmckl_failwith( context, QMCKL_INVALID_ARG_3, "qmckl_get_nucleus_coord", "coord is a null pointer"); } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); int32_t mask = 1 << 3; if ( (ctx->nucleus.uninitialized & mask) != 0) { return qmckl_failwith( context, QMCKL_NOT_PROVIDED, "qmckl_get_nucleus_coord", "nucleus data is not provided"); } int64_t nucl_num = ctx->nucleus.num; assert (ctx->nucleus.coord != NULL); if (transp == 'N') { qmckl_exit_code rc; rc = qmckl_transpose(context, nucl_num, 3, ctx->nucleus.coord, nucl_num, coord, 3); if (rc != QMCKL_SUCCESS) return rc; } else { memcpy(coord, ctx->nucleus.coord, 3*nucl_num*sizeof(double)); } return QMCKL_SUCCESS; } #+end_src When all the data relative to nuclei have been set, the following function returns ~true~. #+begin_src c :comments org :tangle (eval h_func) bool qmckl_nucleus_provided (const qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none bool qmckl_nucleus_provided(const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return false; } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); return ctx->nucleus.provided; } #+end_src ** Initialization functions To set the data relative to the nuclei in the context, the following functions need to be called. #+begin_src c :comments org :tangle (eval h_func) qmckl_exit_code qmckl_set_nucleus_num (qmckl_context context, const int64_t num); qmckl_exit_code qmckl_set_nucleus_charge (qmckl_context context, const double* charge); qmckl_exit_code qmckl_set_nucleus_kappa (qmckl_context context, const double rescale_factor_kappa); qmckl_exit_code qmckl_set_nucleus_coord (qmckl_context context, const char transp, const double* coord); #+end_src #+NAME:pre2 #+begin_src c :exports none if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return QMCKL_NULL_CONTEXT; } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; #+end_src #+NAME:post2 #+begin_src c :exports none ctx->nucleus.uninitialized &= ~mask; ctx->nucleus.provided = (ctx->nucleus.uninitialized == 0); return QMCKL_SUCCESS; #+end_src To set the number of nuclei, use #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_nucleus_num(qmckl_context context, const int64_t num) { <> if (num <= 0) { return qmckl_failwith( context, QMCKL_INVALID_ARG_2, "qmckl_set_nucleus_num", "num <= 0"); } int32_t mask = 1; ctx->nucleus.num = num; <> } #+end_src The following function sets the nuclear charges of all the atoms. #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_nucleus_charge(qmckl_context context, const double* charge) { <> if (charge == NULL) { return qmckl_failwith( context, QMCKL_INVALID_ARG_2, "qmckl_set_nucleus_charge", "charge is a null pointer"); } int64_t num; qmckl_exit_code rc; int32_t mask = 1 << 1; rc = qmckl_get_nucleus_num(context, &num); if (rc != QMCKL_SUCCESS) return rc; if (ctx->nucleus.charge != NULL) { qmckl_free(context, ctx->nucleus.charge); ctx->nucleus.charge= NULL; } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = num*sizeof(double); assert (ctx->nucleus.charge == NULL); ctx->nucleus.charge = (double*) qmckl_malloc(context, mem_info); if (ctx->nucleus.charge == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, "qmckl_set_nucleus_charge", NULL); } ctx->nucleus.charge= memcpy(ctx->nucleus.charge, charge, num*sizeof(double)); assert (ctx->nucleus.charge != NULL); <> } #+end_src The following function sets the rescale parameter for the nuclear distances. #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_nucleus_kappa(qmckl_context context, const double rescale_factor_kappa) { <> //TODO: Check for small values of kappa //if (rescale_factor_kappa == 0) { // return qmckl_failwith( context, // QMCKL_INVALID_ARG_2, // "qmckl_set_nucleus_kappa", // "rescale_factor_kappa cannot be 0"); //} int32_t mask = 1 << 2; int64_t num; qmckl_exit_code rc; ctx->nucleus.rescale_factor_kappa = rescale_factor_kappa; <> } #+end_src The following function sets the nuclear coordinates of all the atoms. The coordinates should be given in atomic units. #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_set_nucleus_coord(qmckl_context context, const char transp, const double* coord) { <> int64_t nucl_num = (int64_t) 0; qmckl_exit_code rc; int32_t mask = 1 << 3; rc = qmckl_get_nucleus_num(context, &nucl_num); if (rc != QMCKL_SUCCESS) return rc; if (ctx->nucleus.coord != NULL) { qmckl_free(context, ctx->nucleus.coord); ctx->nucleus.coord = NULL; } qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = 3*nucl_num*sizeof(double); assert(ctx->nucleus.coord == NULL); ctx->nucleus.coord = (double*) qmckl_malloc(context, mem_info); if (coord == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, "qmckl_set_nucleus_coord", NULL); } if (transp == 'N') { rc = qmckl_transpose(context, 3, nucl_num, coord, 3, ctx->nucleus.coord, nucl_num); if (rc != QMCKL_SUCCESS) return rc; } else { memcpy(ctx->nucleus.coord, coord, 3*nucl_num*sizeof(double)); } <> } #+end_src ** Test #+begin_src c :tangle (eval c_test) const int64_t nucl_num = chbrclf_nucl_num; const double* nucl_charge = chbrclf_charge; const double* nucl_coord = &(chbrclf_nucl_coord[0][0]); const double nucl_rescale_factor_kappa = 1.0; // TODO Change get rescale_factor_kappa from chbrclf example /* --- */ qmckl_exit_code rc; assert(!qmckl_nucleus_provided(context)); int64_t n; rc = qmckl_get_nucleus_num (context, &n); assert(rc == QMCKL_NOT_PROVIDED); rc = qmckl_set_nucleus_num (context, nucl_num); assert(rc == QMCKL_SUCCESS); assert(!qmckl_nucleus_provided(context)); rc = qmckl_get_nucleus_num (context, &n); assert(rc == QMCKL_SUCCESS); assert(n == nucl_num); double k; rc = qmckl_get_nucleus_kappa (context, &k); assert(rc == QMCKL_NOT_PROVIDED); rc = qmckl_set_nucleus_kappa (context, nucl_rescale_factor_kappa); assert(rc == QMCKL_SUCCESS); assert(!qmckl_nucleus_provided(context)); rc = qmckl_get_nucleus_kappa (context, &k); assert(rc == QMCKL_SUCCESS); assert(k == nucl_rescale_factor_kappa); double nucl_coord2[3*nucl_num]; rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2); assert(rc == QMCKL_NOT_PROVIDED); rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0])); assert(rc == QMCKL_SUCCESS); assert(!qmckl_nucleus_provided(context)); rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2); assert(rc == QMCKL_SUCCESS); for (size_t k=0 ; k<3 ; ++k) { for (size_t i=0 ; inucleus.num * ctx->nucleus.num; memcpy(distance, ctx->nucleus.nn_distance, sze * sizeof(double)); return QMCKL_SUCCESS; } #+end_src *** Provide :noexport: #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_provide_nn_distance(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_provide_nn_distance(qmckl_context context) { /* Check input parameters */ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; /* Allocate array */ if (ctx->nucleus.nn_distance == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = ctx->nucleus.num * ctx->nucleus.num * sizeof(double); double* nn_distance = (double*) qmckl_malloc(context, mem_info); if (nn_distance == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, "qmckl_nn_distance", NULL); } ctx->nucleus.nn_distance = nn_distance; } qmckl_exit_code rc = qmckl_compute_nn_distance(context, ctx->nucleus.num, ctx->nucleus.coord, ctx->nucleus.nn_distance); if (rc != QMCKL_SUCCESS) { return rc; } ctx->nucleus.nn_distance_date = ctx->date; return QMCKL_SUCCESS; } #+end_src *** Compute #+NAME: qmckl_nn_distance_args | qmckl_context | context | in | Global state | | int64_t | nucl_num | in | Number of nuclei | | double | coord[3][nucl_num] | in | Nuclear coordinates (au) | | double | nn_distance[nucl_num][nucl_num] | out | Nucleus-nucleus distances (au) | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_nn_distance_f(context, nucl_num, coord, nn_distance) & result(info) use qmckl implicit none integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: nucl_num double precision , intent(in) :: coord(nucl_num,3) double precision , intent(out) :: nn_distance(nucl_num,nucl_num) integer*8 :: k info = QMCKL_SUCCESS if (context == QMCKL_NULL_CONTEXT) then info = QMCKL_INVALID_CONTEXT return endif if (nucl_num <= 0) then info = QMCKL_INVALID_ARG_2 return endif info = qmckl_distance(context, 'T', 'T', nucl_num, nucl_num, & coord, nucl_num, & coord, nucl_num, & nn_distance, nucl_num) end function qmckl_compute_nn_distance_f #+end_src #+begin_src c :tangle (eval h_private_func) :comments org :exports none qmckl_exit_code qmckl_compute_nn_distance ( const qmckl_context context, const int64_t nucl_num, const double* coord, double* const nn_distance ); #+end_src #+CALL: generate_c_interface(table=qmckl_nn_distance_args,rettyp="qmckl_exit_code",fname="qmckl_compute_nn_distance") #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_nn_distance & (context, nucl_num, coord, nn_distance) & 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 :: nucl_num real (c_double ) , intent(in) :: coord(nucl_num,3) real (c_double ) , intent(out) :: nn_distance(nucl_num,nucl_num) integer(c_int32_t), external :: qmckl_compute_nn_distance_f info = qmckl_compute_nn_distance_f & (context, nucl_num, coord, nn_distance) end function qmckl_compute_nn_distance #+end_src *** Test #+begin_src c :tangle (eval c_test) /* Reference input data */ assert(qmckl_nucleus_provided(context)); double distance[nucl_num*nucl_num]; rc = qmckl_get_nucleus_nn_distance(context, distance); assert(distance[0] == 0.); assert(distance[1] == distance[nucl_num]); assert(fabs(distance[1]-2.070304721365169) < 1.e-12); #+end_src ** Nucleus-nucleus rescaled distances *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes qmckl_exit_code qmckl_get_nucleus_nn_distance_rescaled(qmckl_context context, double* distance_rescaled); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_get_nucleus_nn_distance_rescaled(qmckl_context context, double* distance_rescaled) { /* Check input parameters */ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; } qmckl_exit_code rc = qmckl_provide_nn_distance_rescaled(context); if (rc != QMCKL_SUCCESS) return rc; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); size_t sze = ctx->nucleus.num * ctx->nucleus.num; memcpy(distance_rescaled, ctx->nucleus.nn_distance_rescaled, sze * sizeof(double)); return QMCKL_SUCCESS; } #+end_src *** Provide :noexport: #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_provide_nn_distance_rescaled(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_provide_nn_distance_rescaled(qmckl_context context) { /* Check input parameters */ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; /* Allocate array */ if (ctx->nucleus.nn_distance_rescaled == NULL) { qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; mem_info.size = ctx->nucleus.num * ctx->nucleus.num * sizeof(double); double* nn_distance_rescaled = (double*) qmckl_malloc(context, mem_info); if (nn_distance_rescaled == NULL) { return qmckl_failwith( context, QMCKL_ALLOCATION_FAILED, "qmckl_nn_distance_rescaled", NULL); } ctx->nucleus.nn_distance_rescaled = nn_distance_rescaled; } qmckl_exit_code rc = qmckl_compute_nn_distance_rescaled(context, ctx->nucleus.num, ctx->nucleus.rescale_factor_kappa, ctx->nucleus.coord, ctx->nucleus.nn_distance_rescaled); if (rc != QMCKL_SUCCESS) { return rc; } ctx->nucleus.nn_distance_rescaled_date = ctx->date; return QMCKL_SUCCESS; } #+end_src *** Compute #+NAME: qmckl_nn_distance_rescaled_args | qmckl_context | context | in | Global state | | int64_t | nucl_num | in | Number of nuclei | | double | coord[3][nucl_num] | in | Nuclear coordinates (au) | | double | nn_distance_rescaled[nucl_num][nucl_num] | out | Nucleus-nucleus rescaled distances (au) | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_nn_distance_rescaled_f(context, nucl_num, rescale_factor_kappa, coord, nn_distance_rescaled) & result(info) use qmckl implicit none integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: nucl_num double precision , intent(in) :: rescale_factor_kappa double precision , intent(in) :: coord(nucl_num,3) double precision , intent(out) :: nn_distance_rescaled(nucl_num,nucl_num) integer*8 :: k info = QMCKL_SUCCESS if (context == QMCKL_NULL_CONTEXT) then info = QMCKL_INVALID_CONTEXT return endif if (nucl_num <= 0) then info = QMCKL_INVALID_ARG_2 return endif info = qmckl_distance_rescaled(context, 'T', 'T', nucl_num, nucl_num, & coord, nucl_num, & coord, nucl_num, & nn_distance_rescaled, nucl_num, rescale_factor_kappa) end function qmckl_compute_nn_distance_rescaled_f #+end_src #+begin_src c :tangle (eval h_private_func) :comments org :exports none qmckl_exit_code qmckl_compute_nn_distance_rescaled ( const qmckl_context context, const int64_t nucl_num, const double rescale_factor_kappa, const double* coord, double* const nn_distance_rescaled ); #+end_src #+CALL: generate_c_interface(table=qmckl_nn_distance_rescaled_args,rettyp="qmckl_exit_code",fname="qmckl_compute_nn_distance") #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_nn_distance_rescaled & (context, nucl_num, rescale_factor_kappa, coord, nn_distance_rescaled) & 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 :: nucl_num real (c_double ) , intent(in) , value :: rescale_factor_kappa real (c_double ) , intent(in) :: coord(nucl_num,3) real (c_double ) , intent(out) :: nn_distance_rescaled(nucl_num,nucl_num) integer(c_int32_t), external :: qmckl_compute_nn_distance_rescaled_f info = qmckl_compute_nn_distance_rescaled_f & (context, nucl_num, rescale_factor_kappa, coord, nn_distance_rescaled) end function qmckl_compute_nn_distance_rescaled #+end_src *** Test #+begin_src c :tangle (eval c_test) /* Reference input data */ /* TODO */ //assert(qmckl_nucleus_provided(context)); // //double distance[nucl_num*nucl_num]; //rc = qmckl_get_nucleus_nn_distance(context, distance); //assert(distance[0] == 0.); //assert(distance[1] == distance[nucl_num]); //assert(fabs(distance[1]-2.070304721365169) < 1.e-12); #+end_src ** Nuclear repulsion energy \[ V_{NN} = \sum_{A=1}^{N-1} \sum_{B>A}^N \frac{Q_A Q_B}{R_{AB}} \] *** Get #+begin_src c :comments org :tangle (eval h_func) :noweb yes qmckl_exit_code qmckl_get_nucleus_repulsion(qmckl_context context, double* energy); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_get_nucleus_repulsion(qmckl_context context, double* energy) { /* Check input parameters */ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; } qmckl_exit_code rc = qmckl_provide_nucleus_repulsion(context); if (rc != QMCKL_SUCCESS) return rc; qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); *energy = ctx->nucleus.repulsion; return QMCKL_SUCCESS; } #+end_src *** Provide :noexport: #+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none qmckl_exit_code qmckl_provide_nucleus_repulsion(qmckl_context context); #+end_src #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none qmckl_exit_code qmckl_provide_nucleus_repulsion(qmckl_context context) { /* Check input parameters */ if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (char) 0; } qmckl_context_struct* const ctx = (qmckl_context_struct* const) context; assert (ctx != NULL); qmckl_exit_code rc; if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED; rc = qmckl_provide_nn_distance(context); if (rc != QMCKL_SUCCESS) return rc; rc = qmckl_compute_nucleus_repulsion(context, ctx->nucleus.num, ctx->nucleus.charge, ctx->nucleus.nn_distance, &(ctx->nucleus.repulsion)); if (rc != QMCKL_SUCCESS) { return rc; } ctx->nucleus.repulsion_date = ctx->date; return QMCKL_SUCCESS; } #+end_src *** Compute #+NAME: qmckl_nucleus_repulsion_args | qmckl_context | context | in | Global state | | int64_t | nucl_num | in | Number of nuclei | | double | charge[nucl_num] | in | Nuclear charges (au) | | double | nn_distance[nucl_num][nucl_num] | in | Nucleus-nucleus distances (au) | | double | energy | out | Nuclear repulsion energy | #+begin_src f90 :comments org :tangle (eval f) :noweb yes integer function qmckl_compute_nucleus_repulsion_f(context, nucl_num, charge, nn_distance, energy) & result(info) use qmckl implicit none integer(qmckl_context), intent(in) :: context integer*8 , intent(in) :: nucl_num double precision , intent(in) :: charge(nucl_num) double precision , intent(in) :: nn_distance(nucl_num,nucl_num) double precision , intent(out) :: energy integer*8 :: i, j info = QMCKL_SUCCESS if (context == QMCKL_NULL_CONTEXT) then info = QMCKL_INVALID_CONTEXT return endif if (nucl_num <= 0) then info = QMCKL_INVALID_ARG_2 return endif energy = 0.d0 do j=2, nucl_num do i=1, j-1 energy = energy + charge(i) * charge(j) / nn_distance(i,j) end do end do end function qmckl_compute_nucleus_repulsion_f #+end_src #+begin_src c :tangle (eval h_private_func) :comments org :exports none qmckl_exit_code qmckl_compute_nucleus_repulsion ( const qmckl_context context, const int64_t nucl_num, const double* charge, const double* nn_distance, double* energy ); #+end_src #+CALL: generate_c_interface(table=qmckl_nucleus_repulsion_args,rettyp="qmckl_exit_code",fname="qmckl_compute_nucleus_repulsion") #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none integer(c_int32_t) function qmckl_compute_nucleus_repulsion & (context, nucl_num, charge, nn_distance, energy) & 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 :: nucl_num real (c_double ) , intent(in) :: charge(nucl_num) real (c_double ) , intent(in) :: nn_distance(nucl_num,nucl_num) real (c_double ) , intent(out) :: energy integer(c_int32_t), external :: qmckl_compute_nucleus_repulsion_f info = qmckl_compute_nucleus_repulsion_f & (context, nucl_num, charge, nn_distance, energy) end function qmckl_compute_nucleus_repulsion #+end_src *** Test #+begin_src c :tangle (eval c_test) /* Reference input data */ assert(qmckl_nucleus_provided(context)); double rep; rc = qmckl_get_nucleus_repulsion(context, &rep); assert(rep - 318.2309879436158 < 1.e-10); #+end_src * End of files :noexport: #+begin_src c :tangle (eval h_private_type) #endif #+end_src *** Test #+begin_src c :tangle (eval c_test) if (qmckl_context_destroy(context) != QMCKL_SUCCESS) return QMCKL_FAILURE; return 0; } #+end_src *** Compute file names #+begin_src emacs-lisp ; The following is required to compute the file names (setq pwd (file-name-directory buffer-file-name)) (setq name (file-name-nondirectory (substring buffer-file-name 0 -4))) (setq f (concat pwd name "_f.f90")) (setq fh (concat pwd name "_fh.f90")) (setq c (concat pwd name ".c")) (setq h (concat name ".h")) (setq h_private (concat name "_private.h")) (setq c_test (concat pwd "test_" name ".c")) (setq f_test (concat pwd "test_" name "_f.f90")) ; Minted (require 'ox-latex) (setq org-latex-listings 'minted) (add-to-list 'org-latex-packages-alist '("" "listings")) (add-to-list 'org-latex-packages-alist '("" "color")) #+end_src #+RESULTS: # -*- mode: org -*- # vim: syntax=c