mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-08-24 22:21:46 +02:00
560 lines
15 KiB
Org Mode
560 lines
15 KiB
Org Mode
#+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_champ_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_jastrow_champ_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_champ_struct jastrow_champ;
|
|
qmckl_determinant_struct det;
|
|
qmckl_local_energy_struct local_energy;
|
|
|
|
/* To be implemented:
|
|
,*/
|
|
|
|
/* Pointer to implementation-specific data */
|
|
|
|
void* qmckl_extra;
|
|
|
|
} qmckl_context_struct;
|
|
#+end_src
|
|
|
|
The qmckl_extra pointer lets the other implementation of the library
|
|
add specific things to the context. For example a GPU implementation
|
|
of QMCkl will need to store the device ID in the context, and this
|
|
can be made by creating a private data structure containing all
|
|
GPU-specific data, including the device ID.
|
|
|
|
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 = ctx-> date;
|
|
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);
|
|
|
|
rc = qmckl_init_jastrow_champ(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 */
|
|
#ifndef DEBUG
|
|
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);
|
|
#endif
|
|
#+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
|
|
|
|
|