** Context

   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 qmckl_context.c
#include "qmckl.h"
    #+END_SRC

    #+BEGIN_SRC C :tangle test_qmckl_context.c
#include "qmckl.h"
#include "munit.h"
MunitResult test_qmckl_context() {
    #+END_SRC

*** Context

    The context variable is a handle for the state of the library, and
    is stored in the following data structure, which can't be seen
    outside of the library. To simplify compatibility with other
    languages, the pointer to the internal data structure is converted
    into a 64-bit signed integer, defined in the =qmckl_context= type.
    A value of 0 for the context is equivalent to a =NULL= pointer.

    #+BEGIN_SRC C :comments org :tangle qmckl.h
    #+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 qmckl_context.c
typedef struct qmckl_context_struct {
  struct qmckl_context_struct * prev;
  uint32_t tag;
  int32_t precision;
  int32_t range;
} qmckl_context_struct;

#define VALID_TAG   0xBEEFFACE
#define INVALID_TAG 0xDEADBEEF
      #+END_SRC

***** Test                                                         :noexport:
      #+BEGIN_SRC C :tangle test_qmckl_context.c
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 qmckl.h
qmckl_context qmckl_context_check(const qmckl_context context) ;
     #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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 qmckl.h
qmckl_context qmckl_context_create();
       #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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->precision = QMCKL_DEFAULT_PRECISION;
  context->range     = QMCKL_DEFAULT_RANGE;
  context->tag       = VALID_TAG;

  return (qmckl_context) context;
}
      #+END_SRC

***** Fortran interface
      #+BEGIN_SRC f90 :tangle qmckl_f.f90
  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 test_qmckl_context.c
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 qmckl.h
qmckl_context qmckl_context_copy(const qmckl_context context);
       #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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->precision = old_context->precision;
  new_context->range     = old_context->range;
  new_context->tag       = VALID_TAG;

  return (qmckl_context) new_context;
}

      #+END_SRC

***** Fortran interface
      #+BEGIN_SRC f90 :tangle qmckl_f.f90
  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 test_qmckl_context.c
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 qmckl.h
qmckl_context qmckl_context_previous(const qmckl_context context);
       #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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 qmckl_f.f90
  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 test_qmckl_context.c
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 qmckl.h
qmckl_exit_code qmckl_context_destroy(qmckl_context context);
       #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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;
  qmckl_free(ctx);
  return QMCKL_SUCCESS;
}
      #+END_SRC

***** Fortran interface
      #+BEGIN_SRC f90 :tangle qmckl_f.f90
  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 test_qmckl_context.c
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


*** 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 qmckl.h
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, const int precision);
     #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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 qmckl_f.f90
  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 qmckl.h
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, const int range);
      #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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 qmckl_f.f90
  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 or :tangle qmckl.h
qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision);
     #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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(context, precision) == QMCKL_FAILURE) return 0;

  return new_context;
}
      #+END_SRC

***** Fortran interface
      #+BEGIN_SRC f90 :tangle qmckl_f.f90
  interface
     integer (c_int32_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 qmckl.h
qmckl_context qmckl_context_set_range(const qmckl_context context, const int range);
     #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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(context, range) == QMCKL_FAILURE) return 0;

  return new_context;
}
      #+END_SRC

***** Fortran interface
      #+BEGIN_SRC f90 :tangle qmckl_f.f90
  interface
     integer (c_int32_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 qmckl.h
int32_t qmckl_context_get_precision(const qmckl_context context);
     #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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 qmckl_f.f90
  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 qmckl.h
int32_t qmckl_context_get_range(const qmckl_context context);
     #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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 qmckl_f.f90
  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 qmckl.h
double qmckl_context_get_epsilon(const qmckl_context context);
     #+END_SRC

***** Source
      #+BEGIN_SRC C :tangle qmckl_context.c
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 qmckl_f.f90
  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:

*** Info about the molecular system
  
**** TODO =qmckl_context_set_nucl_coord=
**** TODO =qmckl_context_set_nucl_charge=
**** TODO =qmckl_context_set_elec_num=

*** End of files                                                   :noexport:

***** Test
      #+BEGIN_SRC C :comments link :tangle test_qmckl_context.c
return MUNIT_OK;
}
      #+END_SRC

  

 # -*- mode: org -*-
 # vim: syntax=c