From 2735b31c12f779bdefdb9b067c41b51977817ec9 Mon Sep 17 00:00:00 2001 From: v1j4y Date: Thu, 7 Oct 2021 00:27:01 +0200 Subject: [PATCH] Added alpha and beta matrices for all quantities. #41 --- org/qmckl_determinant.org | 533 ++++++++++++++++++++++++-------------- 1 file changed, 334 insertions(+), 199 deletions(-) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 86ec8b0..89a2692 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -92,42 +92,45 @@ int main() { #include "qmckl_mo_private_func.h" #include "qmckl_determinant_private_type.h" #include "qmckl_determinant_private_func.h" +#include "qmckl_blas_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 | + |------------------+------------------------------------------------+------------------------------------| + | ~type~ | ~char~ | α (~'A'~) or β (~'B'~) determinant | + | ~walk_num~ | ~int64_t~ | Number of walkers | + | ~det_num_alpha~ | ~int64_t~ | Number of determinants per walker | + | ~det_num_beta~ | ~int64_t~ | Number of determinants per walker | + | ~fermi_num~ | ~int64_t~ | Number of number of fermions | + | ~mo_index_alpha~ | ~mo_index[det_num_alpha][walk_num][alpha_num]~ | Index of MOs for each walker | + | ~mo_index_beta~ | ~mo_index[det_num_beta][walk_num][beta_num]~ | Index of MOs for each walker | Computed data: - |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| - | ~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. | - |-----------------------------+------------------------------------------------+-------------------------------------------------------------------------------------------| + |-----------------------------+------------------------------------------------------+-------------------------------------------------------------------------------------------| + | ~up_num~ | ~int64_t~ | Number of number of α electrons | + | ~donwn_num~ | ~int64_t~ | Number of number of β electrons | + | ~det_value_alpha~ | ~[det_num_alpha][walk_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~ | ~[det_num_beta][walk_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~ | ~[det_num_alpha][walk_num][alpha_num][alpha_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~ | ~[det_num_beta][walk_num][beta_num][beta_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][det_num_alpha][walk_num][alpha_num][alpha_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][det_num_beta][walk_num][beta_num][beta_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~ | ~[det_num_alpha][walk_num][alpha_num][alpha_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~ | ~[det_num_beta][walk_num][beta_num][beta_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 @@ -135,11 +138,13 @@ int main() { typedef struct qmckl_determinant_struct { char type; int64_t walk_num; - int64_t det_num; + int64_t det_num_alpha; + int64_t det_num_beta ; int64_t up_num; int64_t down_num; int64_t fermi_num; - int64_t* mo_index_list; + int64_t* mo_index_alpha; + int64_t* mo_index_beta; double * det_value_alpha; double * det_value_beta; @@ -174,10 +179,12 @@ typedef struct qmckl_determinant_struct { #+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); +int64_t qmckl_get_determinant_walk_num (const qmckl_context context); +int64_t qmckl_get_determinant_det_num_alpha (const qmckl_context context); +int64_t qmckl_get_determinant_det_num_beta (const qmckl_context context); +int64_t qmckl_get_determinant_fermi_num (const qmckl_context context); +int64_t* qmckl_get_determinant_mo_index_alpha (const qmckl_context context); +int64_t* qmckl_get_determinant_mo_index_beta (const qmckl_context context); #+end_src When all the data for the slater determinants have been provided, the following @@ -233,7 +240,7 @@ int64_t qmckl_get_determinant_walk_num (const qmckl_context context) { return ctx->det.walk_num; } -int64_t qmckl_get_determinant_det_num (const qmckl_context context) { +int64_t qmckl_get_determinant_det_num_alpha (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -247,11 +254,11 @@ int64_t qmckl_get_determinant_det_num (const qmckl_context context) { return (int64_t) 0; } - assert (ctx->det.det_num > (int64_t) 0); - return ctx->det.det_num; + assert (ctx->det.det_num_alpha > (int64_t) 0); + return ctx->det.det_num_alpha; } -int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { +int64_t qmckl_get_determinant_det_num_beta (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -265,11 +272,11 @@ int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { return (int64_t) 0; } - assert (ctx->det.fermi_num > (int64_t) 0); - return ctx->det.fermi_num; + assert (ctx->det.det_num_beta > (int64_t) 0); + return ctx->det.det_num_beta; } -int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { +int64_t qmckl_get_determinant_fermi_num (const qmckl_context context) { if (qmckl_context_check(context) == QMCKL_NULL_CONTEXT) { return (int64_t) 0; } @@ -283,8 +290,44 @@ int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { return (int64_t) 0; } - assert (ctx->det.mo_index_list != NULL); - return ctx->det.mo_index_list; + assert (ctx->det.fermi_num > (int64_t) 0); + return ctx->det.fermi_num; +} + +int64_t* qmckl_get_determinant_mo_index_alpha (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 << 5; + + if ( (ctx->det.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->det.mo_index_alpha != NULL); + return ctx->det.mo_index_alpha; +} + +int64_t* qmckl_get_determinant_mo_index_beta (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 << 6; + + if ( (ctx->det.uninitialized & mask) != 0) { + return (int64_t) 0; + } + + assert (ctx->det.mo_index_beta != NULL); + return ctx->det.mo_index_beta; } #+end_src @@ -297,9 +340,11 @@ int64_t* qmckl_get_determinant_mo_index_list (const qmckl_context context) { #+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_det_num_alpha (const qmckl_context context, const int64_t det_num_alpha); +qmckl_exit_code qmckl_set_determinant_det_num_beta (const qmckl_context context, const int64_t det_num_beta); 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); +qmckl_exit_code qmckl_set_determinant_mo_index_alpha (const qmckl_context context, const int64_t* mo_index_alpha); +qmckl_exit_code qmckl_set_determinant_mo_index_beta (const qmckl_context context, const int64_t* mo_index_beta); #+end_src #+NAME:pre2 @@ -356,18 +401,34 @@ qmckl_exit_code qmckl_set_determinant_walk_num(qmckl_context context, const int6 <> } -qmckl_exit_code qmckl_set_determinant_det_num(qmckl_context context, const int64_t det_num) { +qmckl_exit_code qmckl_set_determinant_det_num_alpha(qmckl_context context, const int64_t det_num_alpha) { <> - if (det_num <= 0) { + if (det_num_alpha <= 0) { return qmckl_failwith( context, QMCKL_INVALID_ARG_2, - "qmckl_set_determinant_det_num", - "det_num <= 0"); + "qmckl_set_determinant_det_num_alpha", + "det_num_alpha <= 0"); } int32_t mask = 1 << 2; - ctx->det.det_num = det_num; + ctx->det.det_num_alpha = det_num_alpha; + + <> +} + +qmckl_exit_code qmckl_set_determinant_det_num_beta(qmckl_context context, const int64_t det_num_beta) { + <> + + if (det_num_beta <= 0) { + return qmckl_failwith( context, + QMCKL_INVALID_ARG_2, + "qmckl_set_determinant_det_num_beta", + "det_num_beta <= 0"); + } + + int32_t mask = 1 << 3; + ctx->det.det_num_beta = det_num_beta; <> } @@ -382,39 +443,70 @@ qmckl_exit_code qmckl_set_determinant_fermi_num(qmckl_context context, const int "fermi_num <= 0"); } - int32_t mask = 1 << 3; + int32_t mask = 1 << 4; ctx->det.fermi_num = fermi_num; <> } -qmckl_exit_code qmckl_set_determinant_mo_index_list(qmckl_context context, const int64_t* mo_index_list) { +qmckl_exit_code qmckl_set_determinant_mo_index_alpha(qmckl_context context, const int64_t* mo_index_alpha) { <> - int32_t mask = 1 << 4; + int32_t mask = 1 << 5; - if (ctx->det.mo_index_list != NULL) { - qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_list); + if (ctx->det.mo_index_alpha != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_alpha); if (rc != QMCKL_SUCCESS) { return qmckl_failwith( context, rc, - "qmckl_set_determinant_mo_index_list", + "qmckl_set_determinant_mo_index_alpha", 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); + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * 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", + "qmckl_set_determinant_mo_index_alpha", NULL); } - memcpy(new_array, mo_index_list, mem_info.size); + memcpy(new_array, mo_index_alpha, mem_info.size); - ctx->det.mo_index_list = new_array; + ctx->det.mo_index_alpha = new_array; + + <> +} + +qmckl_exit_code qmckl_set_determinant_mo_index_beta(qmckl_context context, const int64_t* mo_index_beta) { + <> + + int32_t mask = 1 << 6; + + if (ctx->det.mo_index_beta != NULL) { + qmckl_exit_code rc = qmckl_free(context, ctx->det.mo_index_beta); + if (rc != QMCKL_SUCCESS) { + return qmckl_failwith( context, rc, + "qmckl_set_determinant_mo_index_beta", + NULL); + } + } + + qmckl_memory_info_struct mem_info = qmckl_memory_info_struct_zero; + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * 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_beta", + NULL); + } + + memcpy(new_array, mo_index_beta, mem_info.size); + + ctx->det.mo_index_beta = new_array; <> } @@ -471,7 +563,7 @@ qmckl_exit_code qmckl_get_det_vgl_alpha(qmckl_context context, double * const de 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.up_num * ctx->electron.up_num; + size_t sze = ctx->det.det_num_alpha * 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; @@ -497,7 +589,7 @@ qmckl_exit_code qmckl_get_det_vgl_beta(qmckl_context context, double * const det 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; + size_t sze = ctx->det.det_num_beta * 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; @@ -564,7 +656,7 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { 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); + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_alpha * sizeof(double); double* det_vgl_alpha = (double*) qmckl_malloc(context, mem_info); if (det_vgl_alpha == NULL) { @@ -579,9 +671,10 @@ qmckl_exit_code qmckl_provide_det_vgl_alpha(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_vgl_alpha(context, + ctx->det.det_num_alpha, ctx->det.walk_num, - ctx->det.fermi_num, - ctx->det.mo_index_list, + ctx->electron.up_num, + ctx->det.mo_index_alpha, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, ctx->det.det_vgl_alpha); @@ -652,7 +745,7 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { 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); + mem_info.size = 5 * ctx->det.walk_num * ctx->det.det_num_beta * sizeof(double); double* det_vgl_beta = (double*) qmckl_malloc(context, mem_info); if (det_vgl_beta == NULL) { @@ -667,9 +760,10 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_vgl_beta(context, + ctx->det.det_num_beta, ctx->det.walk_num, - ctx->det.fermi_num, - ctx->det.mo_index_list, + ctx->electron.down_num, + ctx->det.mo_index_beta, ctx->mo_basis.mo_num, ctx->mo_basis.mo_vgl, ctx->det.det_vgl_beta); @@ -697,28 +791,30 @@ qmckl_exit_code qmckl_provide_det_vgl_beta(qmckl_context context) { :END: #+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 | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_alpha_alpha~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_alpha[det_num_alpha_alpha][walk_num][alpha_num]~ | in | MO indices for electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][alpha_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_alpha[det_num_alpha_alpha][walk_num][5][alpha_num][alpha_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_alpha_f(context, & - walk_num, fermi_num, mo_index_list, mo_num, mo_vgl, det_vgl_alpha) & + det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_alpha integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: alpha_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_alpha(fermi_num, fermi_num, walk_num, 5) - integer*8 :: iwalk, ielec, mo_id, imo + integer*8, intent(in) :: mo_index_alpha(alpha_num, walk_num, det_num_alpha) + double precision, intent(in) :: mo_vgl(mo_num, alpha_num, walk_num, 5) + double precision, intent(inout) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha) + integer*8 :: idet, iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -732,32 +828,34 @@ integer function qmckl_compute_det_vgl_alpha_f(context, & return endif - if (fermi_num <= 0) then + if (alpha_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + do idet = 1, det_num_alpha do iwalk = 1, walk_num - do ielec = 1, fermi_num - do imo = 1, fermi_num - mo_id = mo_index_list(imo) + do ielec = 1, alpha_num + do imo = 1, alpha_num + mo_id = mo_index_alpha(imo,iwalk,idet) ! Value - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + det_vgl_alpha(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 1) ! Grad_x - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) + det_vgl_alpha(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) ! Grad_y - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) + det_vgl_alpha(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) ! Grad_z - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) + det_vgl_alpha(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) ! Lap - det_vgl_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) + det_vgl_alpha(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) end do end do end do + end do end function qmckl_compute_det_vgl_alpha_f #+end_src @@ -768,9 +866,10 @@ end function qmckl_compute_det_vgl_alpha_f #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_det_vgl_alpha ( const qmckl_context context, + const int64_t det_num_alpha, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t alpha_num, + const int64_t* mo_index_alpha, const int64_t mo_num, const double* mo_vgl, double* const det_vgl_alpha ); @@ -781,23 +880,24 @@ end function qmckl_compute_det_vgl_alpha_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none 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) & + (context, det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) & 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 :: det_num_alpha 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 :: alpha_num + integer (c_int64_t) , intent(in) :: mo_index_alpha(alpha_num,walk_num,det_num_alpha) 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_alpha(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(in) :: mo_vgl(mo_num,alpha_num,walk_num,5) + real (c_double ) , intent(out) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha) 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) + (context, det_num_alpha, walk_num, alpha_num, mo_index_alpha, mo_num, mo_vgl, det_vgl_alpha) end function qmckl_compute_det_vgl_alpha #+end_src @@ -810,28 +910,30 @@ end function qmckl_compute_det_vgl_alpha_f :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 | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_index_beta[det_num_beta][walk_num][beta_num]~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~mo_vgl[5][walk_num][beta_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_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) & + det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_beta integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: beta_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 + integer*8, intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) + double precision, intent(in) :: mo_vgl(mo_num, beta_num, walk_num, 5) + double precision, intent(inout) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta) + integer*8 :: idet, iwalk, ielec, mo_id, imo info = QMCKL_SUCCESS @@ -845,32 +947,34 @@ integer function qmckl_compute_det_vgl_beta_f(context, & return endif - if (fermi_num <= 0) then + if (beta_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + do idet = 1, det_num_beta do iwalk = 1, walk_num - do ielec = 1, fermi_num - do imo = 1, fermi_num - mo_id = mo_index_list(imo) + do ielec = 1, beta_num + do imo = 1, beta_num + mo_id = mo_index_beta(imo, iwalk, idet) ! Value - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) + det_vgl_beta(imo, ielec, 1, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 1) ! Grad_x - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 2) + det_vgl_beta(imo, ielec, 2, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 2) ! Grad_y - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 3) + det_vgl_beta(imo, ielec, 3, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 3) ! Grad_z - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 4) + det_vgl_beta(imo, ielec, 4, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 4) ! Lap - det_vgl_beta(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 5) + det_vgl_beta(imo, ielec, 5, iwalk, idet) = mo_vgl(mo_id, ielec, iwalk, 5) end do end do end do + end do end function qmckl_compute_det_vgl_beta_f #+end_src @@ -881,41 +985,42 @@ end function qmckl_compute_det_vgl_beta_f #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_det_vgl_beta ( const qmckl_context context, + const int64_t det_num_beta, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t beta_num, + const int64_t* mo_index_beta, 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")) + #+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) & + (context, det_num_beta, walk_num, beta_num, mo_index_beta, 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 :: det_num_beta 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 :: beta_num + integer (c_int64_t) , intent(in) :: mo_index_beta(beta_num,walk_num,det_num_beta) 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) + real (c_double ) , intent(in) :: mo_vgl(mo_num,beta_num,walk_num,5) + real (c_double ) , intent(out) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta) 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) + (context, det_num_beta, walk_num, beta_num, mo_index_beta, mo_num, mo_vgl, det_vgl_beta) end function qmckl_compute_det_vgl_beta #+end_src - *** Test ** Inverse of Determinant matrix @@ -956,7 +1061,7 @@ qmckl_exit_code qmckl_get_det_inv_matrix_alpha(qmckl_context context, double * c 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.up_num * ctx->electron.up_num; + size_t sze = ctx->det.det_num_alpha * 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; @@ -985,7 +1090,7 @@ qmckl_exit_code qmckl_get_det_inv_matrix_beta(qmckl_context context, double * co 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; + size_t sze = ctx->det.det_num_alpha * 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; @@ -1052,7 +1157,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { 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 * + mem_info.size = ctx->det.walk_num * ctx->det.det_num_alpha * ctx->electron.up_num * ctx->electron.up_num * sizeof(double); double* det_inv_matrix_alpha = (double*) qmckl_malloc(context, mem_info); @@ -1068,11 +1173,11 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_inv_matrix_alpha(context, + ctx->det.det_num_alpha, ctx->det.walk_num, ctx->electron.up_num, - ctx->det.mo_index_list, ctx->mo_basis.mo_num, - ctx->mo_basis.mo_vgl, + ctx->det.det_vgl_alpha, ctx->det.det_inv_matrix_alpha); } else { return qmckl_failwith( context, @@ -1141,7 +1246,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { 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 * + mem_info.size = ctx->det.walk_num * ctx->det.det_num_beta * ctx->electron.down_num * ctx->electron.down_num * sizeof(double); double* det_inv_matrix_beta = (double*) qmckl_malloc(context, mem_info); @@ -1157,11 +1262,11 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { qmckl_exit_code rc; if (ctx->det.type == 'G') { rc = qmckl_compute_det_inv_matrix_beta(context, + ctx->det.det_num_beta, 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_vgl_beta, ctx->det.det_inv_matrix_beta); } else { return qmckl_failwith( context, @@ -1179,6 +1284,7 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { return QMCKL_SUCCESS; } #+end_src + *** Compute alpha :PROPERTIES: :Name: qmckl_compute_det_inv_matrix_alpha @@ -1187,28 +1293,32 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) { :END: #+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_alpha[5][walk_num][fermi_num][fermi_num]~ | out | Value, gradients and Laplacian of the Det | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_alpha~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~alpha_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~det_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_inv_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | out | inverse of determinant matrix | #+begin_src f90 :comments org :tangle (eval f) :noweb yes 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) & + det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_alpha integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: alpha_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_alpha(fermi_num, fermi_num, walk_num, 5) - integer*8 :: iwalk, ielec, mo_id, imo + double precision, intent(in) :: det_vgl_alpha(mo_num, alpha_num, 5, walk_num, det_num_alpha) + double precision, intent(inout) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha) + double precision,dimension(:,:),allocatable :: matA + double precision :: det_l + integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res + + allocate(matA(mo_num, alpha_num)) info = QMCKL_SUCCESS @@ -1217,24 +1327,34 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, & return endif - if (walk_num <= 0) then + if (det_num_alpha <= 0) then info = QMCKL_INVALID_ARG_2 return endif - if (fermi_num <= 0) then + if (walk_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + if (alpha_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (mo_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + LDA = alpha_num + do idet = 1, det_num_alpha 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_alpha(imo, ielec, iwalk, 1) = mo_vgl(mo_id, ielec, iwalk, 1) - end do - end do + ! Value + matA = det_vgl_alpha(1:mo_num, 1:alpha_num, 1, iwalk, idet) + res = qmckl_invert(context, alpha_num, alpha_num, LDA, matA, det_l) + det_inv_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA + end do end do end function qmckl_compute_det_inv_matrix_alpha_f @@ -1246,11 +1366,11 @@ end function qmckl_compute_det_inv_matrix_alpha_f #+begin_src c :tangle (eval h_func) :comments org qmckl_exit_code qmckl_compute_det_inv_matrix_alpha ( const qmckl_context context, + const int64_t det_num_alpha, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t alpha_num, const int64_t mo_num, - const double* mo_vgl, + const double* det_vgl_alpha, double* const det_inv_matrix_alpha ); #+end_src @@ -1259,23 +1379,23 @@ end function qmckl_compute_det_inv_matrix_alpha_f #+RESULTS: #+begin_src f90 :tangle (eval f) :comments org :exports none 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) & + (context, det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) & 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 :: det_num_alpha 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 :: alpha_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_alpha(fermi_num,fermi_num,walk_num,5) + real (c_double ) , intent(in) :: det_vgl_alpha(mo_num,alpha_num,5,walk_num,det_num_alpha) + real (c_double ) , intent(out) :: det_inv_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha) 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) + (context, det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_inv_matrix_alpha) end function qmckl_compute_det_inv_matrix_alpha #+end_src @@ -1288,28 +1408,32 @@ end function qmckl_compute_det_inv_matrix_alpha_f :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 | + | ~qmckl_context~ | ~context~ | in | Global state | + | ~int64_t~ | ~det_num_beta~ | in | Number of determinants | + | ~int64_t~ | ~walk_num~ | in | Number of walkers | + | ~int64_t~ | ~beta_num~ | in | Number of electrons | + | ~int64_t~ | ~mo_num~ | in | Number of MOs | + | ~double~ | ~det_vgl_beta[det_num_beta][walk_num][5][beta_num][mo_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs | + | ~double~ | ~det_inv_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | inverse of determinant matrix | #+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) & + det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) & result(info) use qmckl implicit none integer(qmckl_context) , intent(in) :: context + integer*8, intent(in) :: det_num_beta integer*8, intent(in) :: walk_num - integer*8, intent(in) :: fermi_num + integer*8, intent(in) :: beta_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 + double precision, intent(in) :: det_vgl_beta(mo_num, beta_num, 5, walk_num, det_num_beta) + double precision, intent(inout) :: det_inv_matrix_beta(beta_num, beta_num, walk_num, det_num_beta) + double precision,dimension(:,:),allocatable :: matA + double precision :: det_l + integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res + + allocate(matA(mo_num, beta_num)) info = QMCKL_SUCCESS @@ -1318,24 +1442,34 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, & return endif - if (walk_num <= 0) then + if (det_num_beta <= 0) then info = QMCKL_INVALID_ARG_2 return endif - if (fermi_num <= 0) then + if (walk_num <= 0) then info = QMCKL_INVALID_ARG_3 return endif + if (beta_num <= 0) then + info = QMCKL_INVALID_ARG_4 + return + endif + + if (mo_num <= 0) then + info = QMCKL_INVALID_ARG_5 + return + endif + + LDA = beta_num + do idet = 1, det_num_beta 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 + ! Value + matA = det_vgl_beta(1:mo_num, 1:beta_num, 1, iwalk, idet) + res = qmckl_invert(context, beta_num, beta_num, LDA, matA, det_l) + det_inv_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA + end do end do end function qmckl_compute_det_inv_matrix_beta_f @@ -1347,11 +1481,11 @@ end function qmckl_compute_det_inv_matrix_beta_f #+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 det_num_beta, const int64_t walk_num, - const int64_t fermi_num, - const int64_t* mo_index_list, + const int64_t beta_num, const int64_t mo_num, - const double* mo_vgl, + const double* det_vgl_beta, double* const det_inv_matrix_beta ); #+end_src @@ -1360,27 +1494,28 @@ end function qmckl_compute_det_inv_matrix_beta_f #+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) & + (context, det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, 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 :: det_num_beta 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 :: beta_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) + real (c_double ) , intent(in) :: det_vgl_beta(mo_num,beta_num,5,walk_num,det_num_beta) + real (c_double ) , intent(out) :: det_inv_matrix_beta(beta_num,beta_num,walk_num,det_num_beta) 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) + (context, det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_inv_matrix_beta) end function qmckl_compute_det_inv_matrix_beta #+end_src + *** Test * End of files :noexport: