qmckl/src/qmckl_context.org

# -*- mode: org -*-
# vim: syntax=c
#+TITLE: Context

This file is written in C because it is more natural to express the context in
C than in Fortran.

#+BEGIN_SRC C :tangle qmckl_context.h
#ifndef QMCKL_CONTEXT_H
#define QMCKL_CONTEXT_H
#include "qmckl.h"
#+END_SRC

#+BEGIN_SRC C :tangle qmckl_context.c
#include <stdlib.h> /* malloc */
#include "qmckl_context.h"
#+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.

  #+BEGIN_SRC C :tangle qmckl_context.h
/* 64-bit integer */
typedef long long int qmckl_context ;
  #+END_SRC


  #+BEGIN_SRC C :tangle qmckl_context.c
typedef struct qmckl_context_struct {
  struct qmckl_context_struct * prev;
  int precision;
  int range;
} qmckl_context_struct;
  #+END_SRC

** =qmckl_context_create=

   To create a new context, use =qmckl_context_create()=. If the creation
   failed, the function returns =0=. On success, a pointer to a context
   is returned as a 64-bit integer.

   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_create();
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_create() {

  qmckl_context_struct*  context;

  context = (qmckl_context_struct*) malloc (sizeof(qmckl_context_struct));
  if (context == NULL) {
    return (qmckl_context) 0;
  }

  context->prev      = NULL;
  context->precision = QMCKL_DEFAULT_PRECISION;
  context->range     = QMCKL_DEFAULT_RANGE;

  return (qmckl_context) context;
}
   #+END_SRC

** =qmckl_context_copy=

   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_copy(const qmckl_context context);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_copy(const qmckl_context context) {

  qmckl_context_struct* old_context;
  qmckl_context_struct* new_context;

  new_context = (qmckl_context_struct*) malloc (sizeof(qmckl_context_struct));
  if (new_context == NULL) {
    return (qmckl_context) 0;
  }

  old_context = (qmckl_context_struct*) context;

  new_context->prev      = old_context;
  new_context->precision = old_context->precision;
  new_context->range     = old_context->range;

  return (qmckl_context) new_context;
}
   #+END_SRC

** =qmckl_context_destroy=

   To delete a new context, use =qmckl_context_destroy()=. If the deletion
   failed, the function returns =0=. On success, the function returns =1=
   implying that the context has been freed.

   #+BEGIN_SRC C :tangle qmckl_context.h
int qmckl_context_destroy(qmckl_context context);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
int qmckl_context_destroy(qmckl_context context) {

  qmckl_context_struct* ctx;

  ctx = (qmckl_context_struct*) context;

  if (ctx == NULL) {
    return 0;
  }

  free(ctx);
  return 1;
}
   #+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=

   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_update_precision(const qmckl_context context, int precision) {
  qmckl_context_struct* ctx;

  if (precision <  2) return QMCKL_FAILURE;
  if (precision > 53) return QMCKL_FAILURE;

  ctx = (qmckl_context_struct*) context;
  if (ctx == NULL) return QMCKL_FAILURE;

  ctx->precision = precision;
  return QMCKL_SUCCESS;
}
   #+END_SRC

** =qmckl_context_update_range=
   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range);
   #+END_SRC
   
   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_exit_code qmckl_context_update_range(const qmckl_context context, int range) {
  qmckl_context_struct* ctx;

  if (range <  2) return QMCKL_FAILURE;
  if (range > 11) return QMCKL_FAILURE;

  ctx = (qmckl_context_struct*) context;
  if (ctx == NULL) return QMCKL_FAILURE;

  ctx->range = range;
  return QMCKL_SUCCESS;
}
   #+END_SRC



** =qmckl_context_set_precision=

   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_set_precision(const qmckl_context context, int precision);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_set_precision(const qmckl_context context, const int precision) {
  qmckl_context new_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

** =qmckl_context_set_range=
   #+BEGIN_SRC C :tangle qmckl_context.h
qmckl_context qmckl_context_set_range(const qmckl_context context, int range);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_set_range(const qmckl_context context, int range) {
  qmckl_context new_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



** =qmckl_context_get_precision=

   #+BEGIN_SRC C :tangle qmckl_context.h
int qmckl_context_get_precision(const qmckl_context context);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
int qmckl_context_get_precision(const qmckl_context context) {
  qmckl_context_struct* ctx;
  ctx = (qmckl_context_struct*) context;
  return ctx->precision;
}
   #+END_SRC

** =qmckl_context_get_range=

   #+BEGIN_SRC C :tangle qmckl_context.h
int qmckl_context_get_range(const qmckl_context context);
   #+END_SRC

   #+BEGIN_SRC C :tangle qmckl_context.c
int qmckl_context_get_range(const qmckl_context context) {
  qmckl_context_struct* ctx;
  ctx = (qmckl_context_struct*) context;
  return ctx->range;
}
   #+END_SRC

   

* End of header

#+BEGIN_SRC C :tangle qmckl_context.h
#endif
#+END_SRC