2020-10-14 00:52:50 +02:00
|
|
|
# -*- mode: org -*-
|
|
|
|
|
2020-10-14 01:43:13 +02:00
|
|
|
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.
|
|
|
|
|
|
|
|
|
2020-10-14 00:52:50 +02:00
|
|
|
#+BEGIN_SRC C :tangle qmckl_context.c
|
|
|
|
#include <stdlib.h> /* malloc */
|
|
|
|
#include "qmckl_context.h"
|
|
|
|
#+END_SRC
|
|
|
|
|
|
|
|
* Context
|
2020-10-14 01:43:13 +02:00
|
|
|
|
2020-10-14 00:52:50 +02:00
|
|
|
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
|
|
|
|
|
2020-10-14 01:43:13 +02:00
|
|
|
typedef long long int qmckl_context ;
|
2020-10-14 00:52:50 +02:00
|
|
|
#+END_SRC
|
|
|
|
|
|
|
|
|
|
|
|
#+BEGIN_SRC C :tangle qmckl_context.c
|
|
|
|
typedef struct qmckl_context_struct_ {
|
|
|
|
struct qmckl_context_struct_ * prev;
|
2020-10-14 01:43:13 +02:00
|
|
|
int precision;
|
|
|
|
int range;
|
2020-10-14 00:52:50 +02:00
|
|
|
} 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
|
2020-10-14 01:43:13 +02:00
|
|
|
|
|
|
|
#+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
|
|
|
|
|
2020-10-14 00:52:50 +02:00
|
|
|
|
|
|
|
#+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;
|
2020-10-14 01:43:13 +02:00
|
|
|
new_context->precision = old_context->precision;
|
2020-10-14 00:52:50 +02:00
|
|
|
new_context->range = old_context->range;
|
|
|
|
|
|
|
|
return (qmckl_context) new_context;
|
|
|
|
}
|
|
|
|
#+END_SRC
|
2020-10-14 01:43:13 +02:00
|
|
|
|
|
|
|
|
|
|
|
#+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
|
|
|
|
|
2020-10-14 00:52:50 +02:00
|
|
|
|
|
|
|
* 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
|
|
|
|
|
|
|
|
|
|
|
|
|