mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-08-19 03:41:44 +02:00
980 lines
32 KiB
Org Mode
980 lines
32 KiB
Org Mode
#+TITLE: Slater Determinant
|
||
#+SETUPFILE: ../tools/theme.setup
|
||
#+INCLUDE: ../tools/lib.org
|
||
|
||
The slater deteminant is required for the calculation of the
|
||
wavefunction, gradient, and derivatives. These quantities will be used
|
||
to calculate the local Energy (\[E_L\]).
|
||
|
||
ψ(x) = det|ϕ₁(x₁)...ϕᵢ(yᵢ)...ϕₙ(xₙ)|
|
||
|
||
The above slater-matrix is also required and is denoted by Dᵢⱼ(x) such that:
|
||
|
||
ψ(x) = det|Dᵢⱼ(x)|
|
||
|
||
We also require the inverse of the slater-matrix which is denoted by D⁻¹ᵢⱼ(x).
|
||
Using this notation, the acceptance probability which is proportional to
|
||
ψ(y)/ψ(x) can be calculated as follows:
|
||
|
||
ψ(yᵢ)/ψ(xᵢ) = ∑ⱼDᵢⱼ(y)D⁻¹ⱼᵢ(x)
|
||
|
||
Concerning the gradient and laplacian, in fact what is actually
|
||
calculated is the ratio of the gradient/laplacian and the determinant
|
||
of the slater matrix:
|
||
|
||
∇ψ(x)/ψ(x)
|
||
|
||
and
|
||
|
||
∇²ψ(x)/ψ(x)
|
||
|
||
This avoids the unnecessary multiplication and division of by the
|
||
determinant ψ(x).
|
||
|
||
|
||
* Headers :noexport:
|
||
#+begin_src elisp :noexport :results none
|
||
(org-babel-lob-ingest "../tools/lib.org")
|
||
#+end_src
|
||
|
||
|
||
#+begin_src c :tangle (eval h_private_type)
|
||
#ifndef QMCKL_DETERMINANT_HPT
|
||
#define QMCKL_DETERMINANT_HPT
|
||
|
||
#include <stdbool.h>
|
||
#+end_src
|
||
|
||
#+begin_src c :tangle (eval c_test) :noweb yes
|
||
#include "qmckl.h"
|
||
#include "assert.h"
|
||
#ifdef HAVE_CONFIG_H
|
||
#include "config.h"
|
||
#endif
|
||
|
||
#include <stdio.h>
|
||
#include <math.h>
|
||
#include "chbrclf.h"
|
||
#include "qmckl_ao_private_func.h"
|
||
#include "qmckl_mo_private_func.h"
|
||
#include "qmckl_determinant_private_func.h"
|
||
|
||
int main() {
|
||
qmckl_context context;
|
||
context = qmckl_context_create();
|
||
|
||
qmckl_exit_code rc;
|
||
#+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 <stdlib.h>
|
||
#include <string.h>
|
||
#include <stdbool.h>
|
||
#include <assert.h>
|
||
|
||
#include "qmckl.h"
|
||
#include "qmckl_context_private_type.h"
|
||
#include "qmckl_memory_private_type.h"
|
||
#include "qmckl_memory_private_func.h"
|
||
#include "qmckl_ao_private_type.h"
|
||
#include "qmckl_ao_private_func.h"
|
||
#include "qmckl_mo_private_type.h"
|
||
#include "qmckl_mo_private_func.h"
|
||
#include "qmckl_determinant_private_type.h"
|
||
#include "qmckl_determinant_private_func.h"
|
||
#+end_src
|
||
|
||
* Context
|
||
|
||
The following arrays are stored in the context:
|
||
|
||
|-----------------+-------------------------------+------------------------------------|
|
||
| ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant |
|
||
| ~walk_num~ | ~int64_t~ | Number of walkers |
|
||
| ~det_num~ | ~int64_t~ | Number of determinants per walker |
|
||
| ~fermi_num~ | ~int64_t~ | Number of number of fermions |
|
||
| ~mo_index_list~ | ~mo_index[walk_num][det_num]~ | Index of MOs for each walker |
|
||
|
||
Computed data:
|
||
|
||
|----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------|
|
||
| ~det_value_list~ | ~[walk_num][det_num]~ | The slater matrix for each determinant of each walker. |
|
||
| ~det_value_list_date~ | ~int64_t~ | The slater matrix for each determinant of each walker. |
|
||
| ~det_adj_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the slater matrix for each determinant of each walker. |
|
||
| ~det_adj_matrix_list_date~ | ~int64_t~ | Adjoint of the slater matrix for each determinant of each walker. |
|
||
|----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------|
|
||
| ~det_vgl~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵢⱼ(x) at electron positions |
|
||
| ~det_vgl_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions |
|
||
| ~det_inv_matrix_list~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the slater matrix for each determinant of each walker. |
|
||
| ~det_inv_matrix_list_date~ | ~int64_t~ | Inverse of the slater matrix for each determinant of each walker. |
|
||
|----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------|
|
||
|
||
** Data structure
|
||
|
||
#+begin_src c :comments org :tangle (eval h_private_type)
|
||
typedef struct qmckl_determinant_struct {
|
||
char type;
|
||
int64_t walk_num;
|
||
int64_t det_num;
|
||
int64_t fermi_num;
|
||
int64_t* mo_index_list;
|
||
|
||
double * det_matrix_list;
|
||
double * det_adj_matrix_list;
|
||
double * det_inv_matrix_list;
|
||
double * det_vgl;
|
||
int64_t det_matrix_list_date;
|
||
int64_t det_adj_matrix_list_date;
|
||
int64_t det_inv_matrix_list_date;
|
||
int64_t det_vgl_date;
|
||
|
||
int32_t uninitialized;
|
||
bool provided;
|
||
} qmckl_determinant_struct;
|
||
#+end_src
|
||
|
||
The ~uninitialized~ integer contains one bit set to one for each
|
||
initialization function which has not been called. It becomes equal
|
||
to zero after all initialization functions have been called. The
|
||
struct is then initialized and ~provided == true~.
|
||
Some values are initialized by default, and are not concerned by
|
||
this mechanism.
|
||
|
||
** Access functions
|
||
|
||
#+begin_src c :comments org :tangle (eval h_private_func) :exports none
|
||
char qmckl_get_determinant_type (const qmckl_context context);
|
||
int64_t qmckl_get_determinant_walk_num (const qmckl_context context);
|
||
int64_t qmckl_get_determinant_det_num (const qmckl_context context);
|
||
int64_t qmckl_get_determinant_fermi_num (const qmckl_context context);
|
||
int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context);
|
||
#+end_src
|
||
|
||
When all the data for the slater determinants have been provided, the following
|
||
function returns ~true~.
|
||
|
||
#+begin_src c :comments org :tangle (eval h_func)
|
||
bool qmckl_determinant_provided (const qmckl_context context);
|
||
#+end_src
|
||
|
||
#+NAME:post
|
||
#+begin_src c :exports none
|
||
if ( (ctx->det.uninitialized & mask) != 0) {
|
||
return NULL;
|
||
}
|
||
#+end_src
|
||
|
||
|
||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||
char qmckl_get_determinant_type (const qmckl_context context) {
|
||
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return (char) 0;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
int32_t mask = 1;
|
||
|
||
if ( (ctx->det.uninitialized & mask) != 0) {
|
||
return (char) 0;
|
||
}
|
||
|
||
assert (ctx->det.type != (char) 0);
|
||
return ctx->det.type;
|
||
}
|
||
|
||
int64_t qmckl_get_determinant_walk_num (const qmckl_context context) {
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
int32_t mask = 1 << 1;
|
||
|
||
if ( (ctx->det.uninitialized & mask) != 0) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
assert (ctx->det.walk_num > (int64_t) 0);
|
||
return ctx->det.walk_num;
|
||
}
|
||
|
||
int64_t qmckl_get_determinant_det_num (const qmckl_context context) {
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
int32_t mask = 1 << 2;
|
||
|
||
if ( (ctx->det.uninitialized & mask) != 0) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
assert (ctx->det.det_num > (int64_t) 0);
|
||
return ctx->det.det_num;
|
||
}
|
||
|
||
int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) {
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
int32_t mask = 1 << 3;
|
||
|
||
if ( (ctx->det.uninitialized & mask) != 0) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
assert (ctx->det.fermi_num > (int64_t) 0);
|
||
return ctx->det.fermi_num;
|
||
}
|
||
|
||
int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) {
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
int32_t mask = 1 << 4;
|
||
|
||
if ( (ctx->det.uninitialized & mask) != 0) {
|
||
return (int64_t) 0;
|
||
}
|
||
|
||
assert (ctx->det.mo_index_list != NULL);
|
||
return ctx->det.mo_index_list;
|
||
}
|
||
|
||
#+end_src
|
||
|
||
** Initialization functions
|
||
|
||
To set the basis set, all the following functions need to be
|
||
called.
|
||
|
||
#+begin_src c :comments org :tangle (eval h_func)
|
||
qmckl_exit_code qmckl_set_determinant_type (const qmckl_context context, const char t);
|
||
qmckl_exit_code qmckl_set_determinant_walk_num (const qmckl_context context, const int64_t walk_num);
|
||
qmckl_exit_code qmckl_set_determinant_det_num (const qmckl_context context, const int64_t det_num);
|
||
qmckl_exit_code qmckl_set_determinant_fermi_num (const qmckl_context context, const int64_t fermi_num);
|
||
qmckl_exit_code qmckl_set_determinant_mo_index_list (const qmckl_context context, const int64_t* mo_index_list);
|
||
#+end_src
|
||
|
||
#+NAME:pre2
|
||
#+begin_src c :exports none
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return QMCKL_NULL_CONTEXT;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
#+end_src
|
||
|
||
#+NAME:post2
|
||
#+begin_src c :exports none
|
||
ctx->det.uninitialized &= ~mask;
|
||
ctx->det.provided = (ctx->det.uninitialized == 0);
|
||
if (ctx->det.provided) {
|
||
//qmckl_exit_code rc_ = qmckl_finalize_determinant(context);
|
||
//if (rc_ != QMCKL_SUCCESS) return rc_;
|
||
}
|
||
|
||
return QMCKL_SUCCESS;
|
||
#+end_src
|
||
|
||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_set_determinant_type(qmckl_context context, const char t) {
|
||
<<pre2>>
|
||
|
||
if (t != 'G' && t != 'S') {
|
||
return qmckl_failwith( context,
|
||
QMCKL_INVALID_ARG_2,
|
||
"qmckl_set_determinant_type",
|
||
NULL);
|
||
}
|
||
|
||
int32_t mask = 1;
|
||
ctx->det.type = t;
|
||
|
||
<<post2>>
|
||
}
|
||
|
||
qmckl_exit_code qmckl_set_determinant_walk_num(qmckl_context context, const int64_t walk_num) {
|
||
<<pre2>>
|
||
|
||
if (walk_num <= 0) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_INVALID_ARG_2,
|
||
"qmckl_set_determinant_walk_num",
|
||
"walk_num <= 0");
|
||
}
|
||
|
||
int32_t mask = 1 << 1;
|
||
ctx->det.walk_num = walk_num;
|
||
|
||
<<post2>>
|
||
}
|
||
|
||
qmckl_exit_code qmckl_set_determinant_det_num(qmckl_context context, const int64_t det_num) {
|
||
<<pre2>>
|
||
|
||
if (det_num <= 0) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_INVALID_ARG_2,
|
||
"qmckl_set_determinant_det_num",
|
||
"det_num <= 0");
|
||
}
|
||
|
||
int32_t mask = 1 << 2;
|
||
ctx->det.det_num = det_num;
|
||
|
||
<<post2>>
|
||
}
|
||
|
||
qmckl_exit_code qmckl_set_determinant_fermi_num(qmckl_context context, const int64_t fermi_num) {
|
||
<<pre2>>
|
||
|
||
if (fermi_num <= 0) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_INVALID_ARG_2,
|
||
"qmckl_set_slater_fermierminant_det_num",
|
||
"fermi_num <= 0");
|
||
}
|
||
|
||
int32_t mask = 1 << 3;
|
||
ctx->det.fermi_num = fermi_num;
|
||
|
||
<<post2>>
|
||
}
|
||
|
||
qmckl_exit_code qmckl_set_determinant_mo_index_list(qmckl_context context, const int64_t* mo_index_list) {
|
||
<<pre2>>
|
||
|
||
int32_t mask = 1 << 4;
|
||
|
||
if (ctx->det.mo_index_list != NULL) {
|
||
qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_list);
|
||
if (rc != QMCKL_SUCCESS) {
|
||
return qmckl_failwith( context, rc,
|
||
"qmckl_set_determinant_mo_index_list",
|
||
NULL);
|
||
}
|
||
}
|
||
|
||
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
||
mem_info.size = ctx->det.walk_num * ctx->det.det_num * sizeof(int64_t);
|
||
int64_t* new_array = (int64_t*) qmckl_malloc(context, mem_info);
|
||
if (new_array == NULL) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_ALLOCATION_FAILED,
|
||
"qmckl_set_determinant_mo_index_list",
|
||
NULL);
|
||
}
|
||
|
||
memcpy(new_array, mo_index_list, mem_info.size);
|
||
|
||
ctx->det.mo_index_list = new_array;
|
||
|
||
<<post2>>
|
||
}
|
||
|
||
#+end_src
|
||
|
||
When the basis set is completely entered, other data structures are
|
||
computed to accelerate the calculations.
|
||
|
||
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_finalize_basis(qmckl_context context);
|
||
#+end_src
|
||
|
||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) {
|
||
}
|
||
#+end_src
|
||
|
||
** Fortran Interfaces
|
||
** Test
|
||
* Computation
|
||
** Determinant matrix
|
||
:PROPERTIES:
|
||
:Name: qmckl_compute_determinant_det_inv_list
|
||
:CRetType: qmckl_exit_code
|
||
:FRetType: qmckl_exit_code
|
||
:END:
|
||
|
||
*** Get
|
||
#+NAME: qmckl_get_determinant_det_inv_list
|
||
| ~qmckl_context~ | ~context~ | in | Global state |
|
||
| ~double~ | ~det_inv_list[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs |
|
||
|
||
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
||
qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double* const det_inv_list);
|
||
#+end_src
|
||
|
||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_get_determinant_det_inv_list(qmckl_context context, double * const det_inv_list) {
|
||
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return QMCKL_NULL_CONTEXT;
|
||
}
|
||
|
||
qmckl_exit_code rc;
|
||
|
||
rc = qmckl_provide_ao_vgl(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
rc = qmckl_provide_mo_vgl(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
rc = qmckl_provide_det_vgl(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
rc = qmckl_provide_det_inv_matrix(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num;
|
||
memcpy(det_inv_list, ctx->det.det_vgl, sze * sizeof(double));
|
||
|
||
return QMCKL_SUCCESS;
|
||
}
|
||
#+end_src
|
||
|
||
#+CALL: generate_c_header(table=qmckl_get_determinant_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_determinant_det_vgl"))
|
||
|
||
#+RESULTS:
|
||
#+begin_src c :tangle (eval h_func) :comments org
|
||
qmckl_exit_code qmckl_compute_get_determinant_vgl (
|
||
const qmckl_context context,
|
||
double* const det_vgl );
|
||
#+end_src
|
||
|
||
*** Provide
|
||
|
||
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context);
|
||
#+end_src
|
||
|
||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context) {
|
||
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return QMCKL_NULL_CONTEXT;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
if(!(ctx->nucleus.provided)) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_electron",
|
||
NULL);
|
||
}
|
||
|
||
if(!(ctx->electron.provided)) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_electron",
|
||
NULL);
|
||
}
|
||
|
||
if (!ctx->ao_basis.provided) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_ao_basis",
|
||
NULL);
|
||
}
|
||
|
||
if (!ctx->mo_basis.provided) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_mo_basis",
|
||
NULL);
|
||
}
|
||
|
||
if (!ctx->det.provided) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_mo_basis",
|
||
NULL);
|
||
}
|
||
|
||
/* Compute if necessary */
|
||
if (ctx->electron.coord_new_date > ctx->det.det_vgl_date) {
|
||
|
||
/* Allocate array */
|
||
if (ctx->det.det_vgl == NULL) {
|
||
|
||
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
||
mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num * sizeof(double);
|
||
double* det_vgl = (double*) qmckl_malloc(context, mem_info);
|
||
|
||
if (det_vgl == NULL) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_ALLOCATION_FAILED,
|
||
"qmckl_det_vgl",
|
||
NULL);
|
||
}
|
||
ctx->det.det_vgl = det_vgl;
|
||
}
|
||
|
||
qmckl_exit_code rc;
|
||
if (ctx->det.type == 'G') {
|
||
rc = qmckl_compute_det_vgl(context,
|
||
ctx->det.walk_num,
|
||
ctx->det.fermi_num,
|
||
ctx->det.mo_index_list,
|
||
ctx->mo_basis.mo_num,
|
||
ctx->mo_basis.mo_vgl,
|
||
ctx->det.det_vgl);
|
||
} else {
|
||
return qmckl_failwith( context,
|
||
QMCKL_FAILURE,
|
||
"compute_det_vgl",
|
||
"Not yet implemented");
|
||
}
|
||
if (rc != QMCKL_SUCCESS) {
|
||
return rc;
|
||
}
|
||
|
||
ctx->det.det_vgl_date = ctx->date;
|
||
}
|
||
|
||
return QMCKL_SUCCESS;
|
||
}
|
||
#+end_src
|
||
*** Compute
|
||
:PROPERTIES:
|
||
:Name: qmckl_compute_det_vgl
|
||
:CRetType: qmckl_exit_code
|
||
:FRetType: qmckl_exit_code
|
||
:END:
|
||
|
||
#+NAME: qmckl_det_vgl_args
|
||
| ~qmckl_context~ | ~context~ | in | Global state |
|
||
| ~int64_t~ | ~walk_num~ | in | Number of walkers |
|
||
| ~int64_t~ | ~fermi_num~ | in | Number of electrons |
|
||
| ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons |
|
||
| ~int64_t~ | ~mo_num~ | in | Number of MOs |
|
||
| ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs |
|
||
| ~double~ | ~det_vgl[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det |
|
||
|
||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
||
integer function qmckl_compute_det_vgl_f(context, &
|
||
walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl) &
|
||
result(info)
|
||
use qmckl
|
||
implicit none
|
||
integer(qmckl_context) , intent(in) :: context
|
||
integer*8, intent(in) :: walk_num
|
||
integer*8, intent(in) :: fermi_num
|
||
integer*8, intent(in) :: mo_num
|
||
integer*8, intent(in) :: mo_index_list(fermi_num)
|
||
double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5)
|
||
double precision, intent(inout) :: det_vgl(fermi_num, fermi_num, walk_num, 5)
|
||
integer*8 :: iwalk, ielec, mo_id, imo
|
||
|
||
info = QMCKL_SUCCESS
|
||
|
||
if (context == QMCKL_NULL_CONTEXT) then
|
||
info = QMCKL_INVALID_CONTEXT
|
||
return
|
||
endif
|
||
|
||
if (walk_num <= 0) then
|
||
info = QMCKL_INVALID_ARG_2
|
||
return
|
||
endif
|
||
|
||
if (fermi_num <= 0) then
|
||
info = QMCKL_INVALID_ARG_3
|
||
return
|
||
endif
|
||
|
||
do iwalk = 1, walk_num
|
||
do ielec = 1, fermi_num
|
||
do imo = 1, fermi_num
|
||
mo_id = mo_index_list(imo)
|
||
! Value
|
||
det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1)
|
||
|
||
! Grad_x
|
||
det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2)
|
||
|
||
! Grad_y
|
||
det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3)
|
||
|
||
! Grad_z
|
||
det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4)
|
||
|
||
! Lap
|
||
det_vgl(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5)
|
||
end do
|
||
end do
|
||
end do
|
||
|
||
end function qmckl_compute_det_vgl_f
|
||
#+end_src
|
||
|
||
#+CALL: generate_c_header(table=qmckl_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl"))
|
||
|
||
#+RESULTS:
|
||
#+begin_src c :tangle (eval h_func) :comments org
|
||
qmckl_exit_code qmckl_compute_det_vgl (
|
||
const qmckl_context context,
|
||
const int64_t walk_num,
|
||
const int64_t fermi_num,
|
||
const int64_t* mo_index_list,
|
||
const int64_t mo_num,
|
||
const double* mo_vgl,
|
||
double* const det_vgl );
|
||
#+end_src
|
||
|
||
#+CALL: generate_c_interface(table=qmckl_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl"))
|
||
|
||
#+RESULTS:
|
||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||
integer(c_int32_t) function qmckl_compute_det_vgl &
|
||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl) &
|
||
bind(C) result(info)
|
||
|
||
use, intrinsic :: iso_c_binding
|
||
implicit none
|
||
|
||
integer (c_int64_t) , intent(in) , value :: context
|
||
integer (c_int64_t) , intent(in) , value :: walk_num
|
||
integer (c_int64_t) , intent(in) , value :: fermi_num
|
||
integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num)
|
||
integer (c_int64_t) , intent(in) , value :: mo_num
|
||
real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5)
|
||
real (c_double ) , intent(out) :: det_vgl(fermi_num,fermi_num,walk_num,5)
|
||
|
||
integer(c_int32_t), external :: qmckl_compute_det_vgl_f
|
||
info = qmckl_compute_det_vgl_f &
|
||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl)
|
||
|
||
end function qmckl_compute_det_vgl
|
||
#+end_src
|
||
|
||
*** Test
|
||
|
||
** Inverse of Determinant matrix
|
||
:PROPERTIES:
|
||
:Name: qmckl_compute_det_inv_matrix
|
||
:CRetType: qmckl_exit_code
|
||
:FRetType: qmckl_exit_code
|
||
:END:
|
||
|
||
*** Get
|
||
#+NAME: qmckl_get_det_inv_matrix_args
|
||
| ~qmckl_context~ | ~context~ | in | Global state |
|
||
| ~double~ | ~det_inv_matrix_list[5][walk_num][det_num]~ | out | Value, gradients and Laplacian of the MOs |
|
||
|
||
#+begin_src c :comments org :tangle (eval h_func) :noweb yes
|
||
qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double* const det_inv_matrix);
|
||
#+end_src
|
||
|
||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double * const det_inv_matrix) {
|
||
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return QMCKL_NULL_CONTEXT;
|
||
}
|
||
|
||
qmckl_exit_code rc;
|
||
|
||
rc = qmckl_provide_ao_vgl(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
rc = qmckl_provide_mo_vgl(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
rc = qmckl_provide_det_vgl(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
rc = qmckl_provide_det_inv_matrix(context);
|
||
if (rc != QMCKL_SUCCESS) return rc;
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->det.fermi_num * ctx->det.fermi_num;
|
||
memcpy(det_inv_matrix, ctx->det.det_inv_matrix_list, sze * sizeof(double));
|
||
|
||
return QMCKL_SUCCESS;
|
||
}
|
||
#+end_src
|
||
|
||
#+CALL: generate_c_header(table=qmckl_get_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_get_det_inv_matrix"))
|
||
|
||
#+RESULTS:
|
||
#+begin_src c :tangle (eval h_func) :comments org
|
||
qmckl_exit_code qmckl_compute_get_det_inv_matrix (
|
||
const qmckl_context context,
|
||
double* const det_inv_matrix_list );
|
||
#+end_src
|
||
|
||
*** Provide
|
||
|
||
#+begin_src c :comments org :tangle (eval h_private_func) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context);
|
||
#+end_src
|
||
|
||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||
qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context) {
|
||
|
||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||
return QMCKL_NULL_CONTEXT;
|
||
}
|
||
|
||
qmckl_context_struct* const ctx = (qmckl_context_struct* const) context;
|
||
assert (ctx != NULL);
|
||
|
||
if(!(ctx->nucleus.provided)) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_electron",
|
||
NULL);
|
||
}
|
||
|
||
if(!(ctx->electron.provided)) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_electron",
|
||
NULL);
|
||
}
|
||
|
||
if (!ctx->ao_basis.provided) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_ao_basis",
|
||
NULL);
|
||
}
|
||
|
||
if (!ctx->mo_basis.provided) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_mo_basis",
|
||
NULL);
|
||
}
|
||
|
||
if (!ctx->det.provided) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_NOT_PROVIDED,
|
||
"qmckl_mo_basis",
|
||
NULL);
|
||
}
|
||
|
||
/* Compute if necessary */
|
||
if (ctx->electron.coord_new_date > ctx->det.det_inv_matrix_list_date) {
|
||
|
||
/* Allocate array */
|
||
if (ctx->det.det_inv_matrix_list == NULL) {
|
||
|
||
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
||
mem_info.size = ctx->det.walk_num * ctx->det.det_num *
|
||
ctx->det.fermi_num * ctx->det.fermi_num * sizeof(double);
|
||
double* det_inv_matrix_list = (double*) qmckl_malloc(context, mem_info);
|
||
|
||
if (det_inv_matrix_list == NULL) {
|
||
return qmckl_failwith( context,
|
||
QMCKL_ALLOCATION_FAILED,
|
||
"qmckl_det_inv_matrix_list",
|
||
NULL);
|
||
}
|
||
ctx->det.det_inv_matrix_list = det_inv_matrix_list;
|
||
}
|
||
|
||
qmckl_exit_code rc;
|
||
if (ctx->det.type == 'G') {
|
||
rc = qmckl_compute_det_inv_matrix(context,
|
||
ctx->det.walk_num,
|
||
ctx->det.fermi_num,
|
||
ctx->det.mo_index_list,
|
||
ctx->mo_basis.mo_num,
|
||
ctx->mo_basis.mo_vgl,
|
||
ctx->det.det_inv_matrix_list);
|
||
} else {
|
||
return qmckl_failwith( context,
|
||
QMCKL_FAILURE,
|
||
"compute_det_inv_matrix_list",
|
||
"Not yet implemented");
|
||
}
|
||
if (rc != QMCKL_SUCCESS) {
|
||
return rc;
|
||
}
|
||
|
||
ctx->det.det_inv_matrix_list_date = ctx->date;
|
||
}
|
||
|
||
return QMCKL_SUCCESS;
|
||
}
|
||
#+end_src
|
||
*** Compute
|
||
:PROPERTIES:
|
||
:Name: qmckl_compute_det_inv_matrix
|
||
:CRetType: qmckl_exit_code
|
||
:FRetType: qmckl_exit_code
|
||
:END:
|
||
|
||
#+NAME: qmckl_det_inv_matrix_args
|
||
| ~qmckl_context~ | ~context~ | in | Global state |
|
||
| ~int64_t~ | ~walk_num~ | in | Number of walkers |
|
||
| ~int64_t~ | ~fermi_num~ | in | Number of electrons |
|
||
| ~int64_t~ | ~mo_index_list[fermi_num]~ | in | Number of electrons |
|
||
| ~int64_t~ | ~mo_num~ | in | Number of MOs |
|
||
| ~double~ | ~mo_vgl[5][walk_num][fermi_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs |
|
||
| ~double~ | ~det_inv_matrix_list[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det |
|
||
|
||
#+begin_src f90 :comments org :tangle (eval f) :noweb yes
|
||
integer function qmckl_compute_det_inv_matrix_f(context, &
|
||
walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) &
|
||
result(info)
|
||
use qmckl
|
||
implicit none
|
||
integer(qmckl_context) , intent(in) :: context
|
||
integer*8, intent(in) :: walk_num
|
||
integer*8, intent(in) :: fermi_num
|
||
integer*8, intent(in) :: mo_num
|
||
integer*8, intent(in) :: mo_index_list(fermi_num)
|
||
double precision, intent(in) :: mo_vgl(mo_num, fermi_num, walk_num, 5)
|
||
double precision, intent(inout) :: det_inv_matrix_list(fermi_num, fermi_num, walk_num, 5)
|
||
integer*8 :: iwalk, ielec, mo_id, imo
|
||
|
||
info = QMCKL_SUCCESS
|
||
|
||
if (context == QMCKL_NULL_CONTEXT) then
|
||
info = QMCKL_INVALID_CONTEXT
|
||
return
|
||
endif
|
||
|
||
if (walk_num <= 0) then
|
||
info = QMCKL_INVALID_ARG_2
|
||
return
|
||
endif
|
||
|
||
if (fermi_num <= 0) then
|
||
info = QMCKL_INVALID_ARG_3
|
||
return
|
||
endif
|
||
|
||
do iwalk = 1, walk_num
|
||
do ielec = 1, fermi_num
|
||
do imo = 1, fermi_num
|
||
mo_id = mo_index_list(imo)
|
||
! Value
|
||
det_inv_matrix_list(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1)
|
||
end do
|
||
end do
|
||
end do
|
||
|
||
end function qmckl_compute_det_inv_matrix_f
|
||
#+end_src
|
||
|
||
#+CALL: generate_c_header(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix"))
|
||
|
||
#+RESULTS:
|
||
#+begin_src c :tangle (eval h_func) :comments org
|
||
qmckl_exit_code qmckl_compute_det_inv_matrix (
|
||
const qmckl_context context,
|
||
const int64_t walk_num,
|
||
const int64_t fermi_num,
|
||
const int64_t* mo_index_list,
|
||
const int64_t mo_num,
|
||
const double* mo_vgl,
|
||
double* const det_inv_matrix_list );
|
||
#+end_src
|
||
|
||
#+CALL: generate_c_interface(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix"))
|
||
|
||
#+RESULTS:
|
||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||
integer(c_int32_t) function qmckl_compute_det_inv_matrix &
|
||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list) &
|
||
bind(C) result(info)
|
||
|
||
use, intrinsic :: iso_c_binding
|
||
implicit none
|
||
|
||
integer (c_int64_t) , intent(in) , value :: context
|
||
integer (c_int64_t) , intent(in) , value :: walk_num
|
||
integer (c_int64_t) , intent(in) , value :: fermi_num
|
||
integer (c_int64_t) , intent(in) :: mo_index_list(fermi_num)
|
||
integer (c_int64_t) , intent(in) , value :: mo_num
|
||
real (c_double ) , intent(in) :: mo_vgl(mo_num,fermi_num,walk_num,5)
|
||
real (c_double ) , intent(out) :: det_inv_matrix_list(fermi_num,fermi_num,walk_num,5)
|
||
|
||
integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_f
|
||
info = qmckl_compute_det_inv_matrix_f &
|
||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_list)
|
||
|
||
end function qmckl_compute_det_inv_matrix
|
||
#+end_src
|
||
|
||
*** Test
|
||
|
||
* End of files :noexport:
|
||
|
||
#+begin_src c :tangle (eval h_private_type)
|
||
#endif
|
||
#+end_src
|
||
|
||
*** Test
|
||
#+begin_src c :tangle (eval c_test)
|
||
rc = qmckl_context_destroy(context);
|
||
assert (rc == QMCKL_SUCCESS);
|
||
|
||
return 0;
|
||
}
|
||
#+end_src
|
||
|
||
*** Compute file names
|
||
#+begin_src emacs-lisp
|
||
; The following is required to compute the file names
|
||
|
||
(setq pwd (file-name-directory buffer-file-name))
|
||
(setq name (file-name-nondirectory (substring buffer-file-name 0 -4)))
|
||
(setq f (concat pwd name "_f.f90"))
|
||
(setq fh (concat pwd name "_fh.f90"))
|
||
(setq c (concat pwd name ".c"))
|
||
(setq h (concat name ".h"))
|
||
(setq h_private (concat name "_private.h"))
|
||
(setq c_test (concat pwd "test_" name ".c"))
|
||
(setq f_test (concat pwd "test_" name "_f.f90"))
|
||
|
||
; Minted
|
||
(require 'ox-latex)
|
||
(setq org-latex-listings 'minted)
|
||
(add-to-list 'org-latex-packages-alist '("" "listings"))
|
||
(add-to-list 'org-latex-packages-alist '("" "color"))
|
||
|
||
#+end_src
|
||
|
||
|
||
# -*- mode: org -*-
|
||
# vim: syntax=c
|