diff --git a/org/qmckl_blas.org b/org/qmckl_blas.org index b7e8d2f..04d9840 100644 --- a/org/qmckl_blas.org +++ b/org/qmckl_blas.org @@ -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) diff --git a/org/qmckl_determinant.org b/org/qmckl_determinant.org index 78411de..86ec8b0 100644 --- a/org/qmckl_determinant.org +++ b/org/qmckl_determinant.org @@ -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