qmckl/org/qmckl_nucleus.org

#+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_func)
#ifndef QMCKL_NUCLEUS_HPF
#define QMCKL_NUCLEUS_HPF
  #+end_src

  #+begin_src c :tangle (eval h_private_type)
#ifndef QMCKL_NUCLEUS_HPT
#define QMCKL_NUCLEUS_HPT
#include <stdbool.h>
  #+end_src

  #+begin_src c :tangle (eval c_test) :noweb yes
#include "qmckl.h"
#include <assert.h>
#include <stdio.h>
#include <math.h>
#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 <stdint.h>
#elif HAVE_INTTYPES_H
#include <inttypes.h>
#endif

#include <stdlib.h>
#include <string.h>
#include <stdbool.h>
#include <assert.h>
#include <math.h>

#include <stdio.h>

#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~               | qmckl_vector | Nuclear charges                           |
  | ~coord~                | qmckl_matrix | Nuclear coordinates, in transposed format |
  | ~coord_date~           | int64_t      | Nuclear coordinates, date if modified     |
  | ~rescale_factor_kappa~ | double       | The distance scaling factor               |

  Computed data:
  
  |-----------------------------+--------------+------------------------------------------------------------|
  | ~nn_distance~               | qmckl_matrix | Nucleus-nucleus distances                                  |
  | ~nn_distance_date~          | int64_t      | Date when Nucleus-nucleus distances were computed          |
  | ~nn_distance_rescaled~      | qmckl_matrix | 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        |

** 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;
  int64_t      coord_date;
  qmckl_vector charge;
  qmckl_matrix coord;
  qmckl_matrix nn_distance;
  qmckl_matrix 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~.
   Some values are initialized by default, and are not concerned by
   this mechanism.

   #+begin_src c :comments org :tangle (eval h_private_func)
qmckl_exit_code qmckl_init_nucleus(qmckl_context context);
   #+end_src

   #+begin_src c :comments org :tangle (eval c)
qmckl_exit_code qmckl_init_nucleus(qmckl_context context) {

  if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
    return false;
  }

  qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
  assert (ctx != NULL);

  ctx->nucleus.uninitialized = (1 << 3) - 1;

 /* Default values */
  ctx->nucleus.rescale_factor_kappa = 1.0;

  return QMCKL_SUCCESS;
}
   #+end_src

** Access functions
   #+NAME:post
   #+begin_src c  :exports none
if ( (ctx->nucleus.uninitialized & mask) != 0) {
  return NULL;
}
   #+end_src


   #+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);
   #+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*) 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;
}
   #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_get_nucleus_num(context, num) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    integer (c_int64_t) , intent(out)         :: num
  end function qmckl_get_nucleus_num
end interface
    #+end_src


   #+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code
qmckl_get_nucleus_charge(const qmckl_context context,
                         double* const charge,
                         const int64_t size_max);
   #+end_src

   #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_nucleus_charge (const qmckl_context context,
                          double* const charge,
                          const int64_t size_max)
{

  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*) 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.data != NULL);

  if (ctx->nucleus.num > size_max) {
    return qmckl_failwith( context,
                           QMCKL_INVALID_ARG_3,
                           "qmckl_get_nucleus_charge",
                           "Array too small");
  }

  qmckl_exit_code rc;
  rc = qmckl_double_of_vector(context, ctx->nucleus.charge, charge, size_max);

  return rc;
}

   #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_get_nucleus_charge(context, charge, size_max) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    real    (c_double)  , intent(out)         :: charge(*)
    integer (c_int64_t) , intent(in)  , value :: size_max
  end function qmckl_get_nucleus_charge
end interface
    #+end_src


   #+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code
qmckl_get_nucleus_rescale_factor(const qmckl_context context,
                                 double* const rescale_factor_kappa);
   #+end_src

   #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_nucleus_rescale_factor (const qmckl_context context,
                                  double* const rescale_factor_kappa)
{

  if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
    return QMCKL_INVALID_CONTEXT;
  }

  if (rescale_factor_kappa == NULL) {
    return qmckl_failwith( context,
                           QMCKL_INVALID_ARG_2,
                           "qmckl_get_nucleus_rescale_factor",
                           "rescale_factor_kappa is a null pointer");
  }

  qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
  assert (ctx != NULL);

  assert (ctx->nucleus.rescale_factor_kappa > 0.0);

  (*rescale_factor_kappa) = ctx->nucleus.rescale_factor_kappa;

  return QMCKL_SUCCESS;
}
   #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_get_nucleus_rescale_factor(context, kappa) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    real    (c_double)  , intent(out)         :: kappa
  end function qmckl_get_nucleus_rescale_factor
end interface
    #+end_src

   #+begin_src c :comments org :tangle (eval h_func) :exports none
qmckl_exit_code
qmckl_get_nucleus_coord(const qmckl_context context,
                        const char transp,
                        double* const coord,
                        const int64_t size_max);
   #+end_src

   #+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
qmckl_exit_code
qmckl_get_nucleus_coord (const qmckl_context context,
                         const char transp,
                         double* const coord,
                         const int64_t size_max)
{

  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*) 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_coord",
                           "nucleus data is not provided");
  }

  assert (ctx->nucleus.coord.data != NULL);

  qmckl_exit_code rc;

  if (transp == 'N') {
    qmckl_matrix At = qmckl_matrix_alloc(context, 3, ctx->nucleus.coord.size[0]);
    rc = qmckl_transpose(context, ctx->nucleus.coord, At);
    if (rc != QMCKL_SUCCESS) return rc;
    rc = qmckl_double_of_matrix(context, At, coord, size_max);
    qmckl_matrix_free(context, &At);
  } else {
    rc = qmckl_double_of_matrix(context, ctx->nucleus.coord, coord, size_max);
  }

  return rc;
}
   #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_get_nucleus_coord(context, transp, coord, size_max) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    character(c_char)   , intent(in)  , value :: transp
    real    (c_double)  , intent(out)         :: coord(*)
    integer (c_int64_t) , intent(in)  , value :: size_max
  end function qmckl_get_nucleus_coord
end interface
    #+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*) context;
  assert (ctx != NULL);

  return ctx->nucleus.provided;
}
   #+end_src

** Initialization functions

   #+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*) 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 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);
   #+end_src

   Sets the number of nuclei.

   #+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)
{
  <<pre2>>

  if (num <= 0) {
    return qmckl_failwith( context,
                           QMCKL_INVALID_ARG_2,
                           "qmckl_set_nucleus_num",
                           "num <= 0");
  }

  int32_t mask = 1 << 0;

  ctx->nucleus.num = num;

  <<post2>>
}
   #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_set_nucleus_num(context, num) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    integer (c_int64_t) , intent(in)  , value :: num
  end function qmckl_set_nucleus_num
end interface
    #+end_src


   #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_nucleus_charge(qmckl_context context,
                         const double* charge,
                         const int64_t size_max);
   #+end_src

    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,
                         const int64_t size_max)
{
  <<pre2>>

  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 (num > size_max) {
    return qmckl_failwith( context,
                           QMCKL_INVALID_ARG_3,
                           "qmckl_set_nucleus_charge",
                           "Array too small");
  }

  ctx->nucleus.charge = qmckl_vector_alloc(context, num);
  rc = qmckl_vector_of_double(context, charge, num, &(ctx->nucleus.charge));
  if (rc != QMCKL_SUCCESS) {
    return qmckl_failwith( context,
                           QMCKL_FAILURE,
                           "qmckl_set_nucleus_charge",
                           "Error in vector->double* conversion");
  }

  <<post2>>
}
    #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_set_nucleus_charge(context, charge, size_max) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    real    (c_double)  , intent(in)          :: charge(*)
    integer (c_int64_t) , intent(in)  , value :: size_max
  end function
end interface
    #+end_src


    
   #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_nucleus_coord(qmckl_context context,
                        const char transp,
                        const double* coord,
                        const int64_t size_max);
   #+end_src

    Sets the nuclear coordinates of all the atoms. The coordinates
    are 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,
                        const int64_t size_max)
{
  <<pre2>>

  qmckl_exit_code rc;

  int32_t mask = 1 << 2;

  const int64_t nucl_num = (int64_t) ctx->nucleus.num;

  if (ctx->nucleus.coord.data != NULL) {
    rc = qmckl_matrix_free(context, &(ctx->nucleus.coord));
    if (rc != QMCKL_SUCCESS) return rc;
  }

  ctx->nucleus.coord = qmckl_matrix_alloc(context, nucl_num, 3);

  if (ctx->nucleus.coord.data == NULL) {
    return qmckl_failwith( context,
                           QMCKL_ALLOCATION_FAILED,
                           "qmckl_set_nucleus_coord",
                           NULL);
  }

  if (size_max < 3*nucl_num) {
    return qmckl_failwith( context,
                           QMCKL_INVALID_ARG_4,
                           "qmckl_set_nucleus_coord",
                           "Array too small");
  }

  if (transp == 'N') {
    qmckl_matrix At;
    At = qmckl_matrix_alloc(context, 3, nucl_num);
    rc = qmckl_matrix_of_double(context, coord, 3*nucl_num, &At);
    if (rc != QMCKL_SUCCESS) return rc;
    rc = qmckl_transpose(context, At, ctx->nucleus.coord);
  } else {
    rc = qmckl_matrix_of_double(context, coord, nucl_num*3, &(ctx->nucleus.coord));
  }
  if (rc != QMCKL_SUCCESS) return rc;

  <<post2>>
}
    #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_set_nucleus_coord(context, transp, coord, size_max) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    character(c_char)   , intent(in)  , value :: transp
    real    (c_double)  , intent(in)          :: coord(*)
    integer (c_int64_t) , intent(in)  , value :: size_max
  end function qmckl_set_nucleus_coord
end interface
    #+end_src

   #+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_set_nucleus_rescale_factor(qmckl_context context,
                                 const double kappa);
   #+end_src

    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_rescale_factor(qmckl_context context,
                                 const double rescale_factor_kappa)
{
  <<pre2>>

  if (rescale_factor_kappa <= 0.0) {
    return qmckl_failwith( context,
                           QMCKL_INVALID_ARG_2,
                           "qmckl_set_nucleus_rescale_factor",
                           "rescale_factor_kappa cannot be <= 0.");
  }

  ctx->nucleus.rescale_factor_kappa = rescale_factor_kappa;

  return QMCKL_SUCCESS;
}
    #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_set_nucleus_rescale_factor(context, kappa) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    real    (c_double)  , intent(in)  , value :: kappa
  end function qmckl_set_nucleus_rescale_factor
end interface
    #+end_src

** Test

    #+begin_src c :tangle (eval c_test)
const double*   nucl_charge   = chbrclf_charge;
const double*   nucl_coord    = &(chbrclf_nucl_coord[0][0]);
const double    nucl_rescale_factor_kappa = 2.0;

/* --- */

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, chbrclf_nucl_num);
assert(rc == QMCKL_SUCCESS);
assert(!qmckl_nucleus_provided(context));

rc = qmckl_get_nucleus_num (context, &n);
assert(rc == QMCKL_SUCCESS);
assert(n == chbrclf_nucl_num);

double k;
rc = qmckl_get_nucleus_rescale_factor (context, &k);
assert(rc == QMCKL_SUCCESS);
assert(k == 1.0);


rc = qmckl_set_nucleus_rescale_factor (context, nucl_rescale_factor_kappa);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_nucleus_rescale_factor (context, &k);
assert(rc == QMCKL_SUCCESS);
assert(k == nucl_rescale_factor_kappa);

double nucl_coord2[3*chbrclf_nucl_num];

rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*chbrclf_nucl_num);
assert(rc == QMCKL_NOT_PROVIDED);

rc = qmckl_set_nucleus_coord (context, 'T', &(nucl_coord[0]), 3*chbrclf_nucl_num);
assert(rc == QMCKL_SUCCESS);

assert(!qmckl_nucleus_provided(context));

rc = qmckl_get_nucleus_coord (context, 'N', nucl_coord2, 3*chbrclf_nucl_num);
assert(rc == QMCKL_SUCCESS);
for (size_t k=0 ; k<3 ; ++k) {
  for (int64_t i=0 ; i<chbrclf_nucl_num ; ++i) {
    assert( nucl_coord[chbrclf_nucl_num*k+i] == nucl_coord2[3*i+k] );
  }
}

rc = qmckl_get_nucleus_coord (context, 'T', nucl_coord2, 3*chbrclf_nucl_num);
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<3*chbrclf_nucl_num ; ++i) {
  assert( nucl_coord[i] == nucl_coord2[i] );
}

double nucl_charge2[chbrclf_nucl_num];

rc = qmckl_get_nucleus_charge(context, nucl_charge2, chbrclf_nucl_num);
assert(rc == QMCKL_NOT_PROVIDED);

rc = qmckl_set_nucleus_charge(context, nucl_charge, chbrclf_nucl_num);
assert(rc == QMCKL_SUCCESS);

rc = qmckl_get_nucleus_charge(context, nucl_charge2, chbrclf_nucl_num);
assert(rc == QMCKL_SUCCESS);
for (int64_t i=0 ; i<chbrclf_nucl_num ; ++i) {
  assert( nucl_charge[i] == nucl_charge2[i] );
 }
assert(qmckl_nucleus_provided(context));
    #+end_src

* Computation

  The computed data is stored in the context so that it can be reused
  by different kernels. To ensure that the data is valid, for each
  computed data the date of the context is stored when it is computed.
  To know if some data needs to be recomputed, we check if the date of
  the dependencies are more recent than the date of the data to
  compute. If it is the case, then the data is recomputed and the
  current date is stored.

** Nucleus-nucleus distances

*** Get

    #+begin_src c :comments org :tangle (eval h_func) :noweb yes
qmckl_exit_code
qmckl_get_nucleus_nn_distance(qmckl_context context,
                              double* distance,
                              const int64_t size_max);
    #+end_src

    #+begin_src c :comments org :tangle (eval c) :noweb yes  :exports none
qmckl_exit_code
qmckl_get_nucleus_nn_distance(qmckl_context context,
                              double* distance,
                              const int64_t size_max)
{
 /* Check input parameters */
  if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
    return (char) 0;
  }

  qmckl_exit_code rc = qmckl_provide_nn_distance(context);
  if (rc != QMCKL_SUCCESS) return rc;

  qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
  assert (ctx != NULL);

  const int64_t sze = ctx->nucleus.num * ctx->nucleus.num;
  if (sze > size_max) {
    return qmckl_failwith(context,
                          QMCKL_INVALID_ARG_3,
                          "qmckl_get_nucleus_nn_distance",
                          "Array too small");
  }
  rc = qmckl_double_of_matrix(context, ctx->nucleus.nn_distance, distance, size_max);

  return rc;
}
    #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_get_nucleus_nn_distance(context, distance, size_max) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    real    (c_double ) , intent(out)         :: distance(*)
    integer (c_int64_t) , intent(in)  , value :: size_max
  end function
end interface
    #+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*) context;
  assert (ctx != NULL);

  if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED;

 /* Allocate array */
  if (ctx->nucleus.nn_distance.data == NULL) {
    ctx->nucleus.nn_distance =
      qmckl_matrix_alloc(context, ctx->nucleus.num, ctx->nucleus.num);

    if (ctx->nucleus.nn_distance.data == NULL) {
      return qmckl_failwith( context,
                             QMCKL_ALLOCATION_FAILED,
                             "qmckl_nn_distance",
                             NULL);
    }
  }

  qmckl_exit_code rc =
    qmckl_compute_nn_distance(context,
                              ctx->nucleus.num,
                              ctx->nucleus.coord.data,
                              ctx->nucleus.nn_distance.data);
  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[chbrclf_nucl_num*chbrclf_nucl_num];
rc = qmckl_get_nucleus_nn_distance(context, distance, chbrclf_nucl_num*chbrclf_nucl_num);
assert(distance[0] == 0.);
assert(distance[1] == distance[chbrclf_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,
                                       const int64_t size_max);
    #+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,
                                       const int64_t size_max)
{
 /* 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*) context;
  assert (ctx != NULL);

  const int64_t sze = ctx->nucleus.num * ctx->nucleus.num;
  if (sze > size_max) {
    return qmckl_failwith(context,
                          QMCKL_INVALID_ARG_3,
                          "qmckl_get_nucleus_nn_distance_rescaled",
                          "Array too small");
  }
  rc = qmckl_double_of_matrix(context,
                              ctx->nucleus.nn_distance_rescaled,
                              distance_rescaled,
                              size_max);
  return rc;
}
    #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_get_nucleus_nn_distance_rescaled(context, distance_rescaled, size_max) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    real    (c_double ) , intent(out)         :: distance_rescaled(*)
    integer (c_int64_t) , intent(in)  , value :: size_max
  end function
end interface
    #+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*) context;
  assert (ctx != NULL);

  if (!ctx->nucleus.provided) return QMCKL_NOT_PROVIDED;

 /* Allocate array */
  if (ctx->nucleus.nn_distance_rescaled.data == NULL) {
    ctx->nucleus.nn_distance_rescaled =
      qmckl_matrix_alloc(context, ctx->nucleus.num, ctx->nucleus.num);

    if (ctx->nucleus.nn_distance_rescaled.data == NULL) {
      return qmckl_failwith( context,
                             QMCKL_ALLOCATION_FAILED,
                             "qmckl_nn_distance_rescaled",
                             NULL);
    }
  }

  qmckl_exit_code rc =
    qmckl_compute_nn_distance_rescaled(context,
                              ctx->nucleus.num,
                              ctx->nucleus.rescale_factor_kappa,
                              ctx->nucleus.coord.data,
                              ctx->nucleus.nn_distance_rescaled.data);
  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, nucl_num*nucl_num);
//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* const 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* const 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*) context;
  assert (ctx != NULL);

  *energy = ctx->nucleus.repulsion;

  return QMCKL_SUCCESS;
}
    #+end_src

    #+begin_src f90 :tangle (eval fh_func) :comments org :exports none
interface
  integer(c_int32_t) function qmckl_get_nucleus_repulsion(context, energy) &
    bind(C)
    use, intrinsic :: iso_c_binding
    import
    implicit none
    integer (c_int64_t) , intent(in)  , value :: context
    real    (c_double ) , intent(out)         :: energy
  end function
end interface
    #+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*) 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.data,
                                ctx->nucleus.nn_distance.data,
                                &(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
        if (dabs(nn_distance(i,j)) > 1e-5) then
          energy = energy + charge(i) * charge(j) / nn_distance(i,j)
        endif
     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

  #+begin_src c :tangle (eval h_private_func)
#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