# -*- mode: org -*-

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


#+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
#define QMCKL_DEFAULT_PRECISION 53
#define QMCKL_DEFAULT_RANGE     2

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

  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 long 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

  #+BEGIN_SRC fortran :tangle qmckl_context_f.f90
integer(8) function qmckl_context_create()
      use, intrinsic :: iso_c_binding
      implicit none

      interface
         integer(c_long_long) function c_qmckl_context_create() &
                         bind(C, name='qmckl_context_create')
             use, intrinsic :: iso_c_binding, only : c_long_long
         end function
      end interface
      
      qmckl_context_create = c_qmckl_context_create()
end
  #+END_SRC


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

  #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_copy(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


  #+BEGIN_SRC fortran :tangle qmckl_context_f.f90
integer(8) function qmckl_context_copy(context)
      use, intrinsic :: iso_c_binding
      implicit none
      integer(8), intent(in)  :: context

      interface
         integer(c_long_long) function c_qmckl_context_copy(context) &
                         bind(C, name='qmckl_context_copy')
             use, intrinsic :: iso_c_binding, only : c_long_long
             integer(c_long_long), intent(in)  :: context
         end function
      end interface
      
      qmckl_context_copy = c_qmckl_context_copy(context)
end
  #+END_SRC


* Precision

  The following functions set 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.
  These functions return 0 upon success.

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

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

  if (precision <  2) return (qmckl_context) 0;
  if (precision > 53) return (qmckl_context) 0;

  ctx = (qmckl_context_struct*) qmckl_context_copy(context);
  ctx->precision = precision;
  return (qmckl_context) ctx;
}
  #+END_SRC


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

  #+BEGIN_SRC C :tangle qmckl_context.c
qmckl_context qmckl_context_set_range(qmckl_context context, int range) {
  qmckl_context_struct* ctx;

  if (range <  2) return (qmckl_context) 0;
  if (range > 11) return (qmckl_context) 0;

  ctx = (qmckl_context_struct*) qmckl_context_copy(context);
  ctx->range = range;
  return (qmckl_context) ctx;
}
  #+END_SRC