1
0
mirror of https://github.com/TREX-CoE/qmckl.git synced 2024-07-18 08:53:47 +02:00

Fix bug in det_inv_matrix dimension. #41

This commit is contained in:
v1j4y 2021-10-13 16:44:00 +02:00
parent 19b4f93a0b
commit befc1a75fa

View File

@ -914,7 +914,7 @@ end function qmckl_compute_det_vgl_alpha_f
| ~int64_t~ | ~elec_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][elec_num][mo_num]~ | in | Value, gradients and Laplacian of the MOs |
| ~double~ | ~mo_vgl[5][elec_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
@ -1378,7 +1378,6 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_alpha(qmckl_context context) {
ctx->det.det_num_alpha,
ctx->det.walk_num,
ctx->electron.up_num,
ctx->mo_basis.mo_num,
ctx->det.det_vgl_alpha,
ctx->det.det_value_alpha,
ctx->det.det_adj_matrix_alpha,
@ -1471,7 +1470,6 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) {
ctx->det.det_num_beta,
ctx->det.walk_num,
ctx->electron.down_num,
ctx->mo_basis.mo_num,
ctx->det.det_vgl_beta,
ctx->det.det_value_beta,
ctx->det.det_adj_matrix_beta,
@ -1507,15 +1505,14 @@ qmckl_exit_code qmckl_provide_det_inv_matrix_beta(qmckl_context context) {
| ~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_vgl_alpha[det_num_alpha][walk_num][5][alpha_num][alpha_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs |
| ~double~ | ~det_value_alpha[det_num_alpha][walk_num]~ | out | value of determinant matrix |
| ~double~ | ~det_adj_matrix_alpha[det_num_alpha][walk_num][alpha_num][alpha_num]~ | out | adjoint of determinant matrix |
| ~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, &
det_num_alpha, walk_num, alpha_num, mo_num, det_vgl_alpha, det_value_alpha, det_adj_matrix_alpha, det_inv_matrix_alpha) &
det_num_alpha, walk_num, alpha_num, det_vgl_alpha, det_value_alpha, det_adj_matrix_alpha, det_inv_matrix_alpha) &
result(info)
use qmckl
implicit none
@ -1523,8 +1520,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, &
integer*8, intent(in) :: det_num_alpha
integer*8, intent(in) :: walk_num
integer*8, intent(in) :: alpha_num
integer*8, intent(in) :: mo_num
double precision, intent(in) :: det_vgl_alpha(mo_num, alpha_num, 5, walk_num, det_num_alpha)
double precision, intent(in) :: det_vgl_alpha(alpha_num, alpha_num, 5, walk_num, det_num_alpha)
double precision, intent(inout) :: det_value_alpha(walk_num, det_num_alpha)
double precision, intent(inout) :: det_adj_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha)
double precision, intent(inout) :: det_inv_matrix_alpha(alpha_num, alpha_num, walk_num, det_num_alpha)
@ -1532,7 +1528,7 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, &
double precision :: det_l
integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res
allocate(matA(mo_num, alpha_num))
allocate(matA(alpha_num, alpha_num))
info = QMCKL_SUCCESS
@ -1556,19 +1552,14 @@ integer function qmckl_compute_det_inv_matrix_alpha_f(context, &
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
! Value
matA = det_vgl_alpha(1:mo_num, 1:alpha_num, 1, iwalk, idet)
matA = det_vgl_alpha(1:alpha_num, 1:alpha_num, 1, iwalk, idet)
res = qmckl_invert(context, alpha_num, alpha_num, LDA, matA, det_l)
det_adj_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA
det_inv_matrix_alpha(1:mo_num, 1:alpha_num, iwalk, idet) = matA/det_l
det_adj_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA
det_inv_matrix_alpha(1:alpha_num, 1:alpha_num, iwalk, idet) = matA/det_l
det_value_alpha(iwalk, idet) = det_l
end do
end do
@ -1585,7 +1576,6 @@ end function qmckl_compute_det_inv_matrix_alpha_f
const int64_t det_num_alpha,
const int64_t walk_num,
const int64_t alpha_num,
const int64_t mo_num,
const double* det_vgl_alpha,
double* const det_value_alpha,
double* const det_adj_matrix_alpha,
@ -1601,7 +1591,6 @@ end function qmckl_compute_det_inv_matrix_alpha_f
det_num_alpha, &
walk_num, &
alpha_num, &
mo_num, &
det_vgl_alpha, &
det_value_alpha, &
det_adj_matrix_alpha, &
@ -1615,8 +1604,7 @@ end function qmckl_compute_det_inv_matrix_alpha_f
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 :: alpha_num
integer (c_int64_t) , intent(in) , value :: mo_num
real (c_double ) , intent(in) :: det_vgl_alpha(mo_num,alpha_num,5,walk_num,det_num_alpha)
real (c_double ) , intent(in) :: det_vgl_alpha(alpha_num,alpha_num,5,walk_num,det_num_alpha)
real (c_double ) , intent(out) :: det_value_alpha(walk_num,det_num_alpha)
real (c_double ) , intent(out) :: det_adj_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha)
real (c_double ) , intent(out) :: det_inv_matrix_alpha(alpha_num,alpha_num,walk_num,det_num_alpha)
@ -1627,7 +1615,6 @@ end function qmckl_compute_det_inv_matrix_alpha_f
det_num_alpha, &
walk_num, &
alpha_num, &
mo_num, &
det_vgl_alpha, &
det_value_alpha, &
det_adj_matrix_alpha, &
@ -1648,15 +1635,14 @@ end function qmckl_compute_det_inv_matrix_alpha_f
| ~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_vgl_beta[det_num_beta][walk_num][5][beta_num][beta_num]~ | in | determinant matrix Value, gradients and Laplacian of the MOs |
| ~double~ | ~det_value_beta[det_num_beta][walk_num]~ | out | value of determinant matrix |
| ~double~ | ~det_adj_matrix_beta[det_num_beta][walk_num][beta_num][beta_num]~ | out | adjoint of determinant matrix |
| ~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, &
det_num_beta, walk_num, beta_num, mo_num, det_vgl_beta, det_value_beta, det_adj_matrix_beta, det_inv_matrix_beta) &
det_num_beta, walk_num, beta_num, det_vgl_beta, det_value_beta, det_adj_matrix_beta, det_inv_matrix_beta) &
result(info)
use qmckl
implicit none
@ -1664,8 +1650,7 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, &
integer*8, intent(in) :: det_num_beta
integer*8, intent(in) :: walk_num
integer*8, intent(in) :: beta_num
integer*8, intent(in) :: mo_num
double precision, intent(in) :: det_vgl_beta(mo_num, beta_num, 5, walk_num, det_num_beta)
double precision, intent(in) :: det_vgl_beta(beta_num, beta_num, 5, walk_num, det_num_beta)
double precision, intent(inout) :: det_value_beta(walk_num, det_num_beta)
double precision, intent(inout) :: det_adj_matrix_beta(beta_num, beta_num, walk_num, det_num_beta)
double precision, intent(inout) :: det_inv_matrix_beta(beta_num, beta_num, walk_num, det_num_beta)
@ -1673,7 +1658,7 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, &
double precision :: det_l
integer*8 :: idet, iwalk, ielec, mo_id, imo, LDA, res
allocate(matA(mo_num, beta_num))
allocate(matA(beta_num, beta_num))
info = QMCKL_SUCCESS
@ -1697,19 +1682,14 @@ integer function qmckl_compute_det_inv_matrix_beta_f(context, &
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
! Value
matA = det_vgl_beta(1:mo_num, 1:beta_num, 1, iwalk, idet)
matA = det_vgl_beta(1:beta_num, 1:beta_num, 1, iwalk, idet)
res = qmckl_invert(context, beta_num, beta_num, LDA, matA, det_l)
det_adj_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA
det_inv_matrix_beta(1:mo_num, 1:beta_num, iwalk, idet) = matA/det_l
det_adj_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA
det_inv_matrix_beta(1:beta_num, 1:beta_num, iwalk, idet) = matA/det_l
det_value_beta(iwalk, idet) = det_l
end do
end do
@ -1726,7 +1706,6 @@ end function qmckl_compute_det_inv_matrix_beta_f
const int64_t det_num_beta,
const int64_t walk_num,
const int64_t beta_num,
const int64_t mo_num,
const double* det_vgl_beta,
double* const det_value_beta,
double* const det_adj_matrix_beta,
@ -1742,7 +1721,6 @@ end function qmckl_compute_det_inv_matrix_beta_f
det_num_beta, &
walk_num, &
beta_num, &
mo_num, &
det_vgl_beta, &
det_value_beta, &
det_adj_matrix_beta, &
@ -1756,8 +1734,7 @@ end function qmckl_compute_det_inv_matrix_beta_f
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 :: beta_num
integer (c_int64_t) , intent(in) , value :: mo_num
real (c_double ) , intent(in) :: det_vgl_beta(mo_num,beta_num,5,walk_num,det_num_beta)
real (c_double ) , intent(in) :: det_vgl_beta(beta_num,beta_num,5,walk_num,det_num_beta)
real (c_double ) , intent(out) :: det_value_beta(walk_num,det_num_beta)
real (c_double ) , intent(out) :: det_adj_matrix_beta(beta_num,beta_num,walk_num,det_num_beta)
real (c_double ) , intent(out) :: det_inv_matrix_beta(beta_num,beta_num,walk_num,det_num_beta)
@ -1768,7 +1745,6 @@ end function qmckl_compute_det_inv_matrix_beta_f
det_num_beta, &
walk_num, &
beta_num, &
mo_num, &
det_vgl_beta, &
det_value_beta, &
det_adj_matrix_beta, &
@ -1782,13 +1758,13 @@ end function qmckl_compute_det_inv_matrix_beta_f
#+begin_src c :tangle (eval c_test) :exports none
// Get adjoint of the slater-determinant
double det_inv_matrix_alpha[det_num_alpha][walk_num][5][elec_up_num][elec_up_num];
double det_inv_matrix_beta[det_num_beta][walk_num][5][elec_dn_num][elec_dn_num];
double det_inv_matrix_alpha[det_num_alpha][walk_num][elec_up_num][elec_up_num];
double det_inv_matrix_beta[det_num_beta][walk_num][elec_dn_num][elec_dn_num];
rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0][0]));
rc = qmckl_get_det_inv_matrix_alpha(context, &(det_inv_matrix_alpha[0][0][0][0]));
assert (rc == QMCKL_SUCCESS);
rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0][0]));
rc = qmckl_get_det_inv_matrix_beta(context, &(det_inv_matrix_beta[0][0][0][0]));
assert (rc == QMCKL_SUCCESS);
#+end_src