mirror of
https://github.com/TREX-CoE/qmckl.git
synced 2024-07-18 08:53:47 +02:00
Added alpha and beta det matrices. #41
This commit is contained in:
v1j4y
parent
cf394ce171
commit
00d85528c5
@ -395,8 +395,8 @@ end function qmckl_invert_f
|
||||
subroutine invert1(a,LDA,na,det_l)
|
||||
implicit none
|
||||
double precision, intent(inout) :: a (LDA,na)
|
||||
integer, intent(in) :: LDA
|
||||
integer, intent(in) :: na
|
||||
integer*8, intent(in) :: LDA
|
||||
integer*8, intent(in) :: na
|
||||
double precision, intent(inout) :: det_l
|
||||
|
||||
det_l = a(1,1)
|
||||
|
||||
@ -102,22 +102,32 @@ int main() {
|
||||
| ~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 |
|
||||
| ~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. |
|
||||
|----------------------------+------------------------------------------------+----------------------------------------------------------------------------------------|
|
||||
|-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------|
|
||||
| ~up_num~ | ~int64_t~ | Number of number of α electrons |
|
||||
| ~donwn_num~ | ~int64_t~ | Number of number of β electrons |
|
||||
| ~det_value_alpha~ | ~[walk_num][det_num]~ | The α slater matrix for each determinant of each walker. |
|
||||
| ~det_value_alpha_date~ | ~int64_t~ | Date of The α slater matrix for each determinant of each walker. |
|
||||
| ~det_value_beta~ | ~[walk_num][det_num]~ | The β slater matrix for each determinant of each walker. |
|
||||
| ~det_value_beta_date~ | ~int64_t~ | Date of The β slater matrix for each determinant of each walker. |
|
||||
| ~det_adj_matrix_alpha~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the α slater matrix for each determinant of each walker. |
|
||||
| ~det_adj_matrix_alpha_date~ | ~int64_t~ | Date of the Adjoint of the α slater matrix for each determinant of each walker. |
|
||||
| ~det_adj_matrix_beta~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Adjoint of the β slater matrix for each determinant of each walker. |
|
||||
| ~det_adj_matrix_beta_date~ | ~int64_t~ | Date of the Adjoint of the β slater matrix for each determinant of each walker. |
|
||||
|-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------|
|
||||
| ~det_vgl_alpha~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵅᵢⱼ(x) at electron positions |
|
||||
| ~det_vgl_alpha_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions |
|
||||
| ~det_vgl_beta~ | ~[5][walk_num][det_num][fermi_num][fermi_num]~ | Value, gradients, Laplacian of Dᵝᵢⱼ(x) at electron positions |
|
||||
| ~det_vgl_beta_date~ | ~int64_t~ | Late modification date of Value, gradients, Laplacian of the MOs at electron positions |
|
||||
| ~det_inv_matrix_alpha~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the α electron slater matrix for each determinant of each walker. |
|
||||
| ~det_inv_matrix_alpha_date~ | ~int64_t~ | Date for the Inverse of the α electron slater matrix for each determinant of each walker. |
|
||||
| ~det_inv_matrix_beta~ | ~[walk_num][det_num][fermi_num][fermi_num]~ | Inverse of the β electron slater matrix for each determinant of each walker. |
|
||||
| ~det_inv_matrix_beta_date~ | ~int64_t~ | Date for the Inverse of the β electron slater matrix for each determinant of each walker. |
|
||||
|-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------|
|
||||
|
||||
** Data structure
|
||||
|
||||
@ -126,17 +136,27 @@ typedef struct qmckl_determinant_struct {
|
||||
char type;
|
||||
int64_t walk_num;
|
||||
int64_t det_num;
|
||||
int64_t up_num;
|
||||
int64_t down_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;
|
||||
double * det_value_alpha;
|
||||
double * det_value_beta;
|
||||
double * det_vgl_alpha;
|
||||
double * det_adj_matrix_alpha;
|
||||
double * det_inv_matrix_alpha;
|
||||
double * det_vgl_beta;
|
||||
double * det_adj_matrix_beta;
|
||||
double * det_inv_matrix_beta;
|
||||
int64_t det_value_alpha_date;
|
||||
int64_t det_vgl_alpha_date;
|
||||
int64_t det_adj_matrix_alpha_date;
|
||||
int64_t det_inv_matrix_alpha_date;
|
||||
int64_t det_value_beta_date;
|
||||
int64_t det_vgl_beta_date;
|
||||
int64_t det_adj_matrix_beta_date;
|
||||
int64_t det_inv_matrix_beta_date;
|
||||
|
||||
int32_t uninitialized;
|
||||
bool provided;
|
||||
@ -424,16 +444,14 @@ qmckl_exit_code qmckl_finalize_determinant(qmckl_context context) {
|
||||
:END:
|
||||
|
||||
*** Get
|
||||
#+NAME: qmckl_get_det_vgl_args
|
||||
| ~qmckl_context~ | ~context~ | in | Global state |
|
||||
| ~double~ | ~det_vgl[5][walk_num][det_num][fermi_num][fermi_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_vgl(qmckl_context context, double* const det_vgl);
|
||||
qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double* const det_vgl_alpha);
|
||||
qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double* const det_vgl_beta);
|
||||
#+end_src
|
||||
|
||||
#+begin_src c :comments org :tangle (eval c) :noweb yes :exports none
|
||||
qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double * const det_vgl) {
|
||||
qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double * const det_vgl_alpha) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
@ -447,14 +465,40 @@ qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double * const det_vgl)
|
||||
rc = qmckl_provide_mo_vgl(context);
|
||||
if (rc != QMCKL_SUCCESS) return rc;
|
||||
|
||||
rc = qmckl_provide_det_vgl(context);
|
||||
rc = qmckl_provide_det_vgl_alpha(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_vgl, ctx->det.det_vgl, sze * sizeof(double));
|
||||
size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num;
|
||||
memcpy(det_vgl_alpha, ctx->det.det_vgl_alpha, sze * sizeof(double));
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
|
||||
qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double * const det_vgl_beta) {
|
||||
|
||||
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_beta(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->electron.down_num * ctx->electron.down_num;
|
||||
memcpy(det_vgl_beta, ctx->det.det_vgl_beta, sze * sizeof(double));
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
@ -464,11 +508,12 @@ qmckl_exit_code qmckl_get_det_vgl(qmckl_context context, double * const det_vgl)
|
||||
*** 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);
|
||||
qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context);
|
||||
qmckl_exit_code qmckl_provide_det_vgl_beta(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) {
|
||||
qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
@ -513,68 +558,156 @@ qmckl_exit_code qmckl_provide_det_vgl(qmckl_context context) {
|
||||
}
|
||||
|
||||
/* Compute if necessary */
|
||||
if (ctx->electron.coord_new_date > ctx->det.det_vgl_date) {
|
||||
if (ctx->electron.coord_new_date > ctx->det.det_vgl_alpha_date) {
|
||||
|
||||
/* Allocate array */
|
||||
if (ctx->det.det_vgl == NULL) {
|
||||
if (ctx->det.det_vgl_alpha == 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);
|
||||
double* det_vgl_alpha = (double*) qmckl_malloc(context, mem_info);
|
||||
|
||||
if (det_vgl == NULL) {
|
||||
if (det_vgl_alpha == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"qmckl_det_vgl",
|
||||
"qmckl_det_vgl_alpha",
|
||||
NULL);
|
||||
}
|
||||
ctx->det.det_vgl = det_vgl;
|
||||
ctx->det.det_vgl_alpha = det_vgl_alpha;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc;
|
||||
if (ctx->det.type == 'G') {
|
||||
rc = qmckl_compute_det_vgl(context,
|
||||
rc = qmckl_compute_det_vgl_alpha(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);
|
||||
ctx->det.det_vgl_alpha);
|
||||
} else {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_FAILURE,
|
||||
"compute_det_vgl",
|
||||
"compute_det_vgl_alpha",
|
||||
"Not yet implemented");
|
||||
}
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
||||
ctx->det.det_vgl_date = ctx->date;
|
||||
ctx->det.det_vgl_alpha_date = ctx->date;
|
||||
}
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
|
||||
qmckl_exit_code qmckl_provide_det_vgl_beta(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_beta_date) {
|
||||
|
||||
/* Allocate array */
|
||||
if (ctx->det.det_vgl_beta == 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_beta = (double*) qmckl_malloc(context, mem_info);
|
||||
|
||||
if (det_vgl_beta == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"qmckl_det_vgl_beta",
|
||||
NULL);
|
||||
}
|
||||
ctx->det.det_vgl_beta = det_vgl_beta;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc;
|
||||
if (ctx->det.type == 'G') {
|
||||
rc = qmckl_compute_det_vgl_beta(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_beta);
|
||||
} else {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_FAILURE,
|
||||
"compute_det_vgl_beta",
|
||||
"Not yet implemented");
|
||||
}
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
||||
ctx->det.det_vgl_beta_date = ctx->date;
|
||||
}
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
*** Compute
|
||||
*** Compute alpha
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_compute_det_vgl
|
||||
:Name: qmckl_compute_det_vgl_alpha
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
#+NAME: qmckl_compute_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 |
|
||||
#+NAME: qmckl_compute_det_vgl_alpha_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_alpha[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) &
|
||||
integer function qmckl_compute_det_vgl_alpha_f(context, &
|
||||
walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) &
|
||||
result(info)
|
||||
use qmckl
|
||||
implicit none
|
||||
@ -584,7 +717,7 @@ integer function qmckl_compute_det_vgl_f(context, &
|
||||
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)
|
||||
double precision, intent(inout) :: det_vgl_alpha(fermi_num, fermi_num, walk_num, 5)
|
||||
integer*8 :: iwalk, ielec, mo_id, imo
|
||||
|
||||
info = QMCKL_SUCCESS
|
||||
@ -609,46 +742,46 @@ integer function qmckl_compute_det_vgl_f(context, &
|
||||
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)
|
||||
det_vgl_alpha(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)
|
||||
det_vgl_alpha(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)
|
||||
det_vgl_alpha(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)
|
||||
det_vgl_alpha(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)
|
||||
det_vgl_alpha(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 function qmckl_compute_det_vgl_alpha_f
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_header(table=qmckl_compute_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl"))
|
||||
#+CALL: generate_c_header(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_compute_det_vgl (
|
||||
qmckl_exit_code qmckl_compute_det_vgl_alpha (
|
||||
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 );
|
||||
double* const det_vgl_alpha );
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_compute_det_vgl_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl"))
|
||||
#+CALL: generate_c_interface(table=qmckl_compute_det_vgl_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_alpha"))
|
||||
|
||||
#+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) &
|
||||
integer(c_int32_t) function qmckl_compute_det_vgl_alpha &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) &
|
||||
bind(C) result(info)
|
||||
|
||||
use, intrinsic :: iso_c_binding
|
||||
@ -660,13 +793,126 @@ end function qmckl_compute_det_vgl_f
|
||||
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)
|
||||
real (c_double ) , intent(out) :: det_vgl_alpha(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)
|
||||
integer(c_int32_t), external :: qmckl_compute_det_vgl_alpha_f
|
||||
info = qmckl_compute_det_vgl_alpha_f &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha)
|
||||
|
||||
end function qmckl_compute_det_vgl
|
||||
end function qmckl_compute_det_vgl_alpha
|
||||
#+end_src
|
||||
|
||||
*** Compute beta
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_compute_det_vgl_beta
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
#+NAME: qmckl_compute_det_vgl_beta_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_beta[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_beta_f(context, &
|
||||
walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) &
|
||||
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_beta(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_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1)
|
||||
|
||||
! Grad_x
|
||||
det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2)
|
||||
|
||||
! Grad_y
|
||||
det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3)
|
||||
|
||||
! Grad_z
|
||||
det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4)
|
||||
|
||||
! Lap
|
||||
det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end function qmckl_compute_det_vgl_beta_f
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_header(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_compute_det_vgl_beta (
|
||||
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_beta );
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_compute_det_vgl_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_vgl_beta"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_compute_det_vgl_beta &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta) &
|
||||
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_beta(fermi_num,fermi_num,walk_num,5)
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_det_vgl_beta_f
|
||||
info = qmckl_compute_det_vgl_beta_f &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_beta)
|
||||
|
||||
end function qmckl_compute_det_vgl_beta
|
||||
#+end_src
|
||||
|
||||
|
||||
@ -680,16 +926,14 @@ end function qmckl_compute_det_vgl_f
|
||||
: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);
|
||||
qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double* const det_inv_matrix_alpha);
|
||||
qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double* const det_inv_matrix_beta);
|
||||
#+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) {
|
||||
qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double * const det_inv_matrix_alpha) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
@ -703,39 +947,61 @@ qmckl_exit_code qmckl_get_det_inv_matrix(qmckl_context context, double * const d
|
||||
rc = qmckl_provide_mo_vgl(context);
|
||||
if (rc != QMCKL_SUCCESS) return rc;
|
||||
|
||||
rc = qmckl_provide_det_vgl(context);
|
||||
rc = qmckl_provide_det_vgl_alpha(context);
|
||||
if (rc != QMCKL_SUCCESS) return rc;
|
||||
|
||||
rc = qmckl_provide_det_inv_matrix(context);
|
||||
rc = qmckl_provide_det_inv_matrix_alpha(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));
|
||||
size_t sze = ctx->det.det_num * ctx->det.walk_num * ctx->electron.up_num * ctx->electron.up_num;
|
||||
memcpy(det_inv_matrix_alpha, ctx->det.det_inv_matrix_alpha, sze * sizeof(double));
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
|
||||
qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double * const det_inv_matrix_beta) {
|
||||
|
||||
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_alpha(context);
|
||||
if (rc != QMCKL_SUCCESS) return rc;
|
||||
|
||||
rc = qmckl_provide_det_inv_matrix_beta(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->electron.down_num * ctx->electron.down_num;
|
||||
memcpy(det_inv_matrix_beta, ctx->det.det_inv_matrix_beta, 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);
|
||||
qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context);
|
||||
qmckl_exit_code qmckl_provide_det_inv_matrix_beta(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) {
|
||||
qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) {
|
||||
|
||||
if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) {
|
||||
return QMCKL_NULL_CONTEXT;
|
||||
@ -780,69 +1046,158 @@ qmckl_exit_code qmckl_provide_det_inv_matrix(qmckl_context context) {
|
||||
}
|
||||
|
||||
/* Compute if necessary */
|
||||
if (ctx->electron.coord_new_date > ctx->det.det_inv_matrix_list_date) {
|
||||
if (ctx->electron.coord_new_date > ctx->det.det_inv_matrix_alpha_date) {
|
||||
|
||||
/* Allocate array */
|
||||
if (ctx->det.det_inv_matrix_list == NULL) {
|
||||
if (ctx->det.det_inv_matrix_alpha == 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);
|
||||
ctx->electron.up_num * ctx->electron.up_num * sizeof(double);
|
||||
double* det_inv_matrix_alpha = (double*) qmckl_malloc(context, mem_info);
|
||||
|
||||
if (det_inv_matrix_list == NULL) {
|
||||
if (det_inv_matrix_alpha == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"qmckl_det_inv_matrix_list",
|
||||
"qmckl_det_inv_matrix_alpha",
|
||||
NULL);
|
||||
}
|
||||
ctx->det.det_inv_matrix_list = det_inv_matrix_list;
|
||||
ctx->det.det_inv_matrix_alpha = det_inv_matrix_alpha;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc;
|
||||
if (ctx->det.type == 'G') {
|
||||
rc = qmckl_compute_det_inv_matrix(context,
|
||||
rc = qmckl_compute_det_inv_matrix_alpha(context,
|
||||
ctx->det.walk_num,
|
||||
ctx->det.fermi_num,
|
||||
ctx->electron.up_num,
|
||||
ctx->det.mo_index_list,
|
||||
ctx->mo_basis.mo_num,
|
||||
ctx->mo_basis.mo_vgl,
|
||||
ctx->det.det_inv_matrix_list);
|
||||
ctx->det.det_inv_matrix_alpha);
|
||||
} else {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_FAILURE,
|
||||
"compute_det_inv_matrix_list",
|
||||
"compute_det_inv_matrix_alpha",
|
||||
"Not yet implemented");
|
||||
}
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
||||
ctx->det.det_inv_matrix_list_date = ctx->date;
|
||||
ctx->det.det_inv_matrix_alpha_date = ctx->date;
|
||||
}
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
|
||||
qmckl_exit_code qmckl_provide_det_inv_matrix_beta(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_beta_date) {
|
||||
|
||||
/* Allocate array */
|
||||
if (ctx->det.det_inv_matrix_beta == NULL) {
|
||||
|
||||
qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero;
|
||||
mem_info.size = ctx->det.walk_num * ctx->det.det_num *
|
||||
ctx->electron.down_num * ctx->electron.down_num * sizeof(double);
|
||||
double* det_inv_matrix_beta = (double*) qmckl_malloc(context, mem_info);
|
||||
|
||||
if (det_inv_matrix_beta == NULL) {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_ALLOCATION_FAILED,
|
||||
"qmckl_det_inv_matrix_beta",
|
||||
NULL);
|
||||
}
|
||||
ctx->det.det_inv_matrix_beta = det_inv_matrix_beta;
|
||||
}
|
||||
|
||||
qmckl_exit_code rc;
|
||||
if (ctx->det.type == 'G') {
|
||||
rc = qmckl_compute_det_inv_matrix_beta(context,
|
||||
ctx->det.walk_num,
|
||||
ctx->electron.down_num,
|
||||
ctx->det.mo_index_list,
|
||||
ctx->mo_basis.mo_num,
|
||||
ctx->mo_basis.mo_vgl,
|
||||
ctx->det.det_inv_matrix_beta);
|
||||
} else {
|
||||
return qmckl_failwith( context,
|
||||
QMCKL_FAILURE,
|
||||
"compute_det_inv_matrix_beta",
|
||||
"Not yet implemented");
|
||||
}
|
||||
if (rc != QMCKL_SUCCESS) {
|
||||
return rc;
|
||||
}
|
||||
|
||||
ctx->det.det_inv_matrix_beta_date = ctx->date;
|
||||
}
|
||||
|
||||
return QMCKL_SUCCESS;
|
||||
}
|
||||
#+end_src
|
||||
*** Compute
|
||||
*** Compute alpha
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_compute_det_inv_matrix
|
||||
:Name: qmckl_compute_det_inv_matrix_alpha
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
#+NAME: qmckl_det_inv_matrix_args
|
||||
#+NAME: qmckl_det_inv_matrix_alpha_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 |
|
||||
| ~double~ | ~det_inv_matrix_alpha[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) &
|
||||
integer function qmckl_compute_det_inv_matrix_alpha_f(context, &
|
||||
walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) &
|
||||
result(info)
|
||||
use qmckl
|
||||
implicit none
|
||||
@ -852,7 +1207,7 @@ integer function qmckl_compute_det_inv_matrix_f(context, &
|
||||
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)
|
||||
double precision, intent(inout) :: det_inv_matrix_alpha(fermi_num, fermi_num, walk_num, 5)
|
||||
integer*8 :: iwalk, ielec, mo_id, imo
|
||||
|
||||
info = QMCKL_SUCCESS
|
||||
@ -877,34 +1232,34 @@ integer function qmckl_compute_det_inv_matrix_f(context, &
|
||||
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)
|
||||
det_inv_matrix_alpha(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 function qmckl_compute_det_inv_matrix_alpha_f
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_header(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix"))
|
||||
#+CALL: generate_c_header(table=qmckl_det_inv_matrix_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_alpha"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_compute_det_inv_matrix (
|
||||
qmckl_exit_code qmckl_compute_det_inv_matrix_alpha (
|
||||
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 );
|
||||
double* const det_inv_matrix_alpha );
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_det_inv_matrix_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix"))
|
||||
#+CALL: generate_c_interface(table=qmckl_det_inv_matrix_alpha_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_alpha"))
|
||||
|
||||
#+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) &
|
||||
integer(c_int32_t) function qmckl_compute_det_inv_matrix_alpha &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha) &
|
||||
bind(C) result(info)
|
||||
|
||||
use, intrinsic :: iso_c_binding
|
||||
@ -916,13 +1271,114 @@ end function qmckl_compute_det_inv_matrix_f
|
||||
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)
|
||||
real (c_double ) , intent(out) :: det_inv_matrix_alpha(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)
|
||||
integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_alpha_f
|
||||
info = qmckl_compute_det_inv_matrix_alpha_f &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_alpha)
|
||||
|
||||
end function qmckl_compute_det_inv_matrix
|
||||
end function qmckl_compute_det_inv_matrix_alpha
|
||||
#+end_src
|
||||
|
||||
*** Compute beta
|
||||
:PROPERTIES:
|
||||
:Name: qmckl_compute_det_inv_matrix_beta
|
||||
:CRetType: qmckl_exit_code
|
||||
:FRetType: qmckl_exit_code
|
||||
:END:
|
||||
|
||||
#+NAME: qmckl_det_inv_matrix_beta_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_beta[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_beta_f(context, &
|
||||
walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) &
|
||||
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_beta(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_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end function qmckl_compute_det_inv_matrix_beta_f
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_header(table=qmckl_det_inv_matrix_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_beta"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src c :tangle (eval h_func) :comments org
|
||||
qmckl_exit_code qmckl_compute_det_inv_matrix_beta (
|
||||
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_beta );
|
||||
#+end_src
|
||||
|
||||
#+CALL: generate_c_interface(table=qmckl_det_inv_matrix_beta_args,rettyp=get_value("CRetType"),fname="qmckl_compute_det_inv_matrix_beta"))
|
||||
|
||||
#+RESULTS:
|
||||
#+begin_src f90 :tangle (eval f) :comments org :exports none
|
||||
integer(c_int32_t) function qmckl_compute_det_inv_matrix_beta &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta) &
|
||||
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_beta(fermi_num,fermi_num,walk_num,5)
|
||||
|
||||
integer(c_int32_t), external :: qmckl_compute_det_inv_matrix_beta_f
|
||||
info = qmckl_compute_det_inv_matrix_beta_f &
|
||||
(context, walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_inv_matrix_beta)
|
||||
|
||||
end function qmckl_compute_det_inv_matrix_beta
|
||||
#+end_src
|
||||
|
||||
*** Test
|
||||
|
||||
Loading…
Reference in New Issue
Block a user