TREX/qmckl
1
0
Fork 0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-11-05 13:44:07 +01:00
Code Issues Projects Releases Wiki Activity
1b6cf47f0d
qmckl/org/qmckl_context.org
Anthony Scemama 6fb261d635 warnings
2022-04-05 11:15:42 +02:00

544 lines
15 KiB
Org Mode
Raw Blame History

#+TITLE: Context
#+SETUPFILE: ../tools/theme.setup
#+INCLUDE: ../tools/lib.org
* Headers :noexport:
#+begin_src c :tangle (eval c_test) :noweb yes
#include "qmckl.h"
#include "assert.h"
#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
int main() {
#+end_src
#+begin_src c :tangle (eval h_private_type) :noweb yes
#ifndef QMCKL_CONTEXT_HPT
#define QMCKL_CONTEXT_HPT
#ifdef HAVE_STDINT_H
#include <stdint.h>
#elif HAVE_INTTYPES_H
#include <inttypes.h>
#endif
#include <pthread.h>
#include "qmckl_error_private_type.h"
#include "qmckl_memory_private_type.h"
#include "qmckl_numprec_private_type.h"
#include "qmckl_point_private_type.h"
#include "qmckl_nucleus_private_type.h"
#include "qmckl_electron_private_type.h"
#include "qmckl_ao_private_type.h"
#include "qmckl_mo_private_type.h"
#include "qmckl_jastrow_private_type.h"
#include "qmckl_determinant_private_type.h"
#include "qmckl_local_energy_private_type.h"
#include "qmckl_point_private_func.h"
#include "qmckl_nucleus_private_func.h"
#include "qmckl_electron_private_func.h"
#include "qmckl_ao_private_func.h"
#include "qmckl_mo_private_func.h"
#include "qmckl_determinant_private_func.h"
#include "qmckl_local_energy_private_func.h"
#+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 <assert.h>
#include <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <errno.h>
#include <pthread.h>
#include "qmckl.h"
#include "qmckl_context_private_type.h"
#include "qmckl_memory_private_func.h"
#+end_src
* Context handling
The context variable is a handle for the state of the library,
and is stored in a 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 ~QMCKL_NULL_CONTEXT~ for the context is equivalent to a ~NULL~ pointer.
#+NAME: qmckl_context
#+begin_src c :comments org :tangle (eval h_type)
typedef int64_t qmckl_context ;
#define QMCKL_NULL_CONTEXT (qmckl_context) 0
#+end_src
#+begin_src f90 :comments org :tangle (eval fh_type) :exports none
integer , parameter :: qmckl_context = c_int64_t
integer*8, parameter :: QMCKL_NULL_CONTEXT = 0
#+end_src
An immutable context would have required to implement a garbage
collector. To keep the library simple, we have chosen to implement
the context as a mutable data structure, so it has to be handled
with care.
By convention, in this file ~context~ is a ~qmckl_context~ variable
and ~ctx~ is a ~qmckl_context_struct*~ pointer.
** Data structure
#+begin_src c :comments org :tangle (eval h_private_type) :noweb yes :exports none
typedef struct qmckl_context_struct {
/* -- State of the library -- */
/* Validity checking */
uint64_t tag;
/* Numerical precision */
qmckl_numprec_struct numprec;
/* Thread lock */
int lock_count;
pthread_mutex_t mutex;
/* Error handling */
qmckl_error_struct error;
/* Memory allocation */
qmckl_memory_struct memory;
/* Current date */
uint64_t date;
/* Points */
qmckl_point_struct point;
/* -- Molecular system -- */
qmckl_nucleus_struct nucleus;
qmckl_electron_struct electron;
qmckl_ao_basis_struct ao_basis;
qmckl_mo_basis_struct mo_basis;
qmckl_jastrow_struct jastrow;
qmckl_determinant_struct det;
qmckl_local_energy_struct local_energy;
/* To be implemented:
,*/
} qmckl_context_struct;
#+end_src
A tag is used internally to check if the memory domain pointed
by a pointer is a valid context. This allows to check that even if
the pointer associated with a context is non-null, we can still
verify that it points to the expected data structure.
#+begin_src c :comments org :tangle (eval h_private_type) :noweb yes :exports none
#define VALID_TAG 0xBEEFFACE
#define INVALID_TAG 0xDEADBEEF
#+end_src
The ~qmckl_context_check~ function checks if the domain pointed by
the pointer is a valid context. It returns the input ~qmckl_context~
if the context is valid, ~QMCKL_NULL_CONTEXT~ otherwise.
#+begin_src c :comments org :tangle (eval h_func) :noexport
qmckl_context
qmckl_context_check (const qmckl_context context) ;
#+end_src
#+begin_src c :tangle (eval c) :exports none
qmckl_context qmckl_context_check(const qmckl_context context) {
if (context == QMCKL_NULL_CONTEXT)
return QMCKL_NULL_CONTEXT;
const qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
/* Try to access memory */
if (ctx->tag != VALID_TAG) {
return QMCKL_NULL_CONTEXT;
}
return context;
}
#+end_src
The context keeps a /date/ that allows to check which data needs
to be recomputed. The date is incremented when the context is touched.
When a new element is added to the context, the functions
[[Creation][=qmckl_context_create=]] [[Destroy][=qmckl_context_destroy=]] and [[Copy][=qmckl_context_copy=]]
should be updated in order to make deep copies.
When the electron coordinates have changed, the context is touched
using the following function.
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_context_touch (const qmckl_context context);
#+end_src
This has the effect to increment the date of the context.
#+begin_src c :tangle (eval c) :exports none
qmckl_exit_code
qmckl_context_touch(const qmckl_context context)
{
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
return qmckl_failwith( context,
QMCKL_INVALID_CONTEXT,
"qmckl_context_touch",
NULL);
}
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
ctx->date += 1UL;
ctx->point.date += 1UL;
return QMCKL_SUCCESS;
}
#+end_src
** Creation
To create a new context, ~qmckl_context_create()~ should be used.
- Upon success, it returns a pointer to a new context with the ~qmckl_context~ type
- It returns ~QMCKL_NULL_CONTEXT~ upon failure to allocate the internal data structure
- A new context always has all its members initialized with a NULL value
# Header
#+begin_src c :comments org :tangle (eval h_func)
qmckl_context qmckl_context_create();
#+end_src
# Source
#+begin_src c :tangle (eval c) :exports none
qmckl_context qmckl_context_create() {
qmckl_context_struct* const ctx =
(qmckl_context_struct*) malloc (sizeof(qmckl_context_struct));
if (ctx == NULL) {
return QMCKL_NULL_CONTEXT;
}
/* Set all pointers and values to NULL */
{
memset(ctx, 0, sizeof(qmckl_context_struct));
}
/* Initialize lock */
{
pthread_mutexattr_t attr;
int rc;
rc = pthread_mutexattr_init(&attr);
assert (rc == 0);
#ifdef PTHREAD_MUTEX_RECURSIVE
(void) pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
#endif
rc = pthread_mutex_init ( &(ctx->mutex), &attr);
assert (rc == 0);
(void) pthread_mutexattr_destroy(&attr);
}
/* Initialize data */
{
ctx->tag = VALID_TAG;
const qmckl_context context = (qmckl_context) ctx;
assert ( qmckl_context_check(context) != QMCKL_NULL_CONTEXT );
qmckl_exit_code rc;
ctx->numprec.precision = QMCKL_DEFAULT_PRECISION;
ctx->numprec.range = QMCKL_DEFAULT_RANGE;
rc = qmckl_init_point(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_init_electron(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_init_nucleus(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_init_ao_basis(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_init_mo_basis(context);
assert (rc == QMCKL_SUCCESS);
rc = qmckl_init_determinant(context);
assert (rc == QMCKL_SUCCESS);
}
/* Allocate qmckl_memory_struct */
{
const size_t size = 128L;
qmckl_memory_info_struct * new_array = calloc(size, sizeof(qmckl_memory_info_struct));
if (new_array == NULL) {
free(ctx);
return QMCKL_NULL_CONTEXT;
}
memset( &(new_array[0]), 0, size * sizeof(qmckl_memory_info_struct) );
ctx->memory.element = new_array;
ctx->memory.array_size = size;
ctx->memory.n_allocated = (size_t) 0;
}
return (qmckl_context) ctx;
}
#+end_src
# Fortran interface
#+begin_src f90 :tangle (eval fh_func) :exports none
interface
integer (qmckl_context) function qmckl_context_create() bind(C)
use, intrinsic :: iso_c_binding
import
end function qmckl_context_create
end interface
#+end_src
# Test
#+begin_src c :comments link :tangle (eval c_test) :exports none
assert( qmckl_context_check(QMCKL_NULL_CONTEXT) == QMCKL_NULL_CONTEXT);
qmckl_context context = qmckl_context_create();
assert( context != QMCKL_NULL_CONTEXT );
assert( qmckl_context_check(context) == context );
#+end_src
** Locking
For thread safety, the context may be locked/unlocked. The lock is
initialized with the ~PTHREAD_MUTEX_RECURSIVE~ attribute, and the
number of times the thread has locked it is saved in the
~lock_count~ attribute.
# Header
#+begin_src c :comments org :tangle (eval h_func)
void qmckl_lock (qmckl_context context);
void qmckl_unlock(qmckl_context context);
#+end_src
# Source
#+begin_src c :tangle (eval c) :exports none
void qmckl_lock(qmckl_context context) {
if (context == QMCKL_NULL_CONTEXT)
return ;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
errno = 0;
int rc = pthread_mutex_lock( &(ctx->mutex) );
if (rc != 0) {
fprintf(stderr, "DEBUG qmckl_lock:%s\n", strerror(rc) );
fflush(stderr);
}
assert (rc == 0);
ctx->lock_count += 1;
}
void qmckl_unlock(const qmckl_context context) {
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
int rc = pthread_mutex_unlock( &(ctx->mutex) );
if (rc != 0) {
fprintf(stderr, "DEBUG qmckl_unlock:%s\n", strerror(rc) );
fflush(stderr);
}
assert (rc == 0);
ctx->lock_count -= 1;
}
#+end_src
** TODO Copy
~qmckl_context_copy~ makes a deep copy of a context. It returns
~QMCKL_NULL_CONTEXT~ upon failure.
# Header
#+begin_src c :comments org :tangle (eval h_func) :exports none
/*
qmckl_context qmckl_context_copy(const qmckl_context context);
*/
#+end_src
# Source
#+begin_src c :tangle (eval c) :exports none
qmckl_context qmckl_context_copy(const qmckl_context context) {
const qmckl_context checked_context = qmckl_context_check(context);
if (checked_context == QMCKL_NULL_CONTEXT) {
return QMCKL_NULL_CONTEXT;
}
/*
qmckl_lock(context);
{
const qmckl_context_struct* const old_ctx =
(qmckl_context_struct*) checked_context;
qmckl_context_struct* const new_ctx =
(qmckl_context_struct*) malloc (context, sizeof(qmckl_context_struct));
if (new_ctx == NULL) {
qmckl_unlock(context);
return QMCKL_NULL_CONTEXT;
}
* Copy the old context on the new one *
* TODO Deep copies should be done here *
memcpy(new_ctx, old_ctx, sizeof(qmckl_context_struct));
qmckl_unlock( (qmckl_context) new_ctx );
return (qmckl_context) new_ctx;
}
qmckl_unlock(context);
*/
return QMCKL_NULL_CONTEXT;
}
#+end_src
# Fortran interface
#+begin_src f90 :tangle (eval fh_func) :exports none
! interface
! integer (qmckl_context) function qmckl_context_copy(context) bind(C)
! use, intrinsic :: iso_c_binding
! import
! integer (qmckl_context), intent(in), value :: context
! end function qmckl_context_copy
! end interface
#+end_src
# Test
#+begin_src c :comments link :tangle (eval c_test) :exports none
/*
qmckl_context new_context = qmckl_context_copy(context);
munit_assert_int64(new_context, !=, QMCKL_NULL_CONTEXT);
munit_assert_int64(new_context, !=, context);
munit_assert_int64(qmckl_context_check(new_context), ==, new_context);
*/
#+end_src
** Destroy
The context is destroyed with ~qmckl_context_destroy~, leaving the ancestors untouched.
It frees the context, and returns the previous context.
# Header
#+begin_src c :comments org :tangle (eval h_func)
qmckl_exit_code
qmckl_context_destroy (const qmckl_context context);
#+end_src
# Source
#+begin_src c :tangle (eval c) :exports none
qmckl_exit_code
qmckl_context_destroy (const qmckl_context context)
{
const qmckl_context checked_context = qmckl_context_check(context);
if (checked_context == QMCKL_NULL_CONTEXT) return QMCKL_INVALID_CONTEXT;
qmckl_context_struct* const ctx = (qmckl_context_struct*) context;
assert (ctx != NULL); /* Shouldn't be possible because the context is valid */
qmckl_lock(context);
{
/* Memory: Remove all allocated data */
for (size_t pos = (size_t) 0 ; pos < ctx->memory.array_size ; ++pos) {
if (ctx->memory.element[pos].pointer != NULL) {
free(ctx->memory.element[pos].pointer);
memset( &(ctx->memory.element[pos]), 0, sizeof(qmckl_memory_info_struct) );
ctx->memory.n_allocated -= 1;
}
}
assert (ctx->memory.n_allocated == (size_t) 0);
free(ctx->memory.element);
ctx->memory.element = NULL;
ctx->memory.array_size = (size_t) 0;
}
qmckl_unlock(context);
ctx->tag = INVALID_TAG;
const int rc_destroy = pthread_mutex_destroy( &(ctx->mutex) );
if (rc_destroy != 0) {
/* DEBUG */
fprintf(stderr, "qmckl_context_destroy: %s (count = %d)\n", strerror(rc_destroy), ctx->lock_count);
abort();
}
free(ctx);
return QMCKL_SUCCESS;
}
#+end_src
# Fortran interface
#+begin_src f90 :tangle (eval fh_func) :exports none
interface
integer (qmckl_exit_code) function qmckl_context_destroy(context) bind(C)
use, intrinsic :: iso_c_binding
import
integer (qmckl_context), intent(in), value :: context
end function qmckl_context_destroy
end interface
#+end_src
# Test
#+begin_src c :tangle (eval c_test) :exports none
/* Destroy valid context */
assert(qmckl_context_check(context) == context);
assert(qmckl_context_destroy(context) == QMCKL_SUCCESS);
/* Check that context is destroyed */
assert(qmckl_context_check(context) != context);
assert(qmckl_context_check(context) == QMCKL_NULL_CONTEXT);
/* Destroy invalid context */
assert(qmckl_context_destroy(QMCKL_NULL_CONTEXT) == QMCKL_INVALID_CONTEXT);
#+end_src
* End of files :noexport:
#+begin_src c :comments link :tangle (eval h_private_type)
#endif
#+end_src
*** Test
#+begin_src c :comments link :tangle (eval c_test)
return 0;
}
#+end_src
Reference in New Issue View Git Blame Copy Permalink