diff --git a/src/det.irp.f b/src/det.irp.f index 9b1f6d0..1484b95 100644 --- a/src/det.irp.f +++ b/src/det.irp.f @@ -1467,30 +1467,6 @@ END_PROVIDER END_PROVIDER - BEGIN_PROVIDER [ double precision, single_det_value ] -&BEGIN_PROVIDER [ double precision, single_det_grad, (elec_num_8,3) ] -&BEGIN_PROVIDER [ double precision, single_det_lapl, (elec_num) ] - BEGIN_DOC - ! Value of a single determinant wave function from the 1st determinant - END_DOC - det_i = 1 - det_j = 1 - integer :: i - single_det_value = det_alpha_value_curr * det_beta_value_curr - do i=1,elec_alpha_num - single_det_grad(i,1) = det_alpha_grad_lapl_curr(1,i) * det_beta_value_curr - single_det_grad(i,2) = det_alpha_grad_lapl_curr(2,i) * det_beta_value_curr - single_det_grad(i,3) = det_alpha_grad_lapl_curr(3,i) * det_beta_value_curr - single_det_lapl(i) = det_alpha_grad_lapl_curr(4,i) * det_beta_value_curr - enddo - do i=elec_alpha_num+1,elec_num - single_det_grad(i,1) = det_alpha_value_curr * det_beta_grad_lapl_curr(1,i) - single_det_grad(i,2) = det_alpha_value_curr * det_beta_grad_lapl_curr(2,i) - single_det_grad(i,3) = det_alpha_value_curr * det_beta_grad_lapl_curr(3,i) - single_det_lapl(i) = det_alpha_value_curr * det_beta_grad_lapl_curr(4,i) - enddo -END_PROVIDER - BEGIN_PROVIDER [ double precision, psidet_value ] &BEGIN_PROVIDER [ double precision, psidet_inv ] @@ -1609,62 +1585,26 @@ END_PROVIDER ! Gradients ! --------- + call dgemv('N',elec_alpha_num*4,det_alpha_num,1.d0, & + det_alpha_grad_lapl, & + size(det_alpha_grad_lapl,1)*size(det_alpha_grad_lapl,2), & + CDb, 1, 0.d0, psidet_grad_lapl, 1) + if (elec_beta_num /= 0) then + call dgemv('N',elec_beta_num*4,det_beta_num,1.d0, & + det_beta_grad_lapl(1,elec_alpha_num+1,1), & + size(det_beta_grad_lapl,1)*size(det_beta_grad_lapl,2), & + DaC, 1, 0.d0, psidet_grad_lapl(1,elec_alpha_num+1), 1) + endif + if (do_pseudo) then - do j=1,elec_num - psidet_grad_lapl(1:4,j) = 0.d0 - pseudo_non_local(j) = 0.d0 - enddo - - do i=1,det_alpha_num - do j=1,elec_alpha_num - !DIR$ VECTOR ALIGNED - do k=1,4 - psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_alpha_grad_lapl(k,j,i)*CDb(i) - enddo - pseudo_non_local(j) = pseudo_non_local(j) + det_alpha_pseudo(j,i)*CDb(i) - enddo - enddo - - do i=1,det_beta_num - do j=elec_alpha_num+1,elec_num - !DIR$ VECTOR ALIGNED - do k=1,4 - psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_beta_grad_lapl(k,j,i)*DaC(i) - enddo - pseudo_non_local(j) = pseudo_non_local(j) + det_beta_pseudo(j,i)*DaC(i) - enddo - enddo - - !DIR$ VECTOR ALIGNED - do j=1,elec_num - pseudo_non_local(j) = pseudo_non_local(j) * psidet_inv - enddo - - else - - !DIR$ VECTOR ALIGNED - do j=1,elec_num - psidet_grad_lapl(1:4,j) = 0.d0 - enddo - - do i=1,det_alpha_num - do j=1,elec_alpha_num - !DIR$ VECTOR ALIGNED - do k=1,4 - psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_alpha_grad_lapl(k,j,i)*CDb(i) - enddo - enddo - enddo - - do i=1,det_beta_num - do j=elec_alpha_num+1,elec_num - !DIR$ VECTOR ALIGNED - do k=1,4 - psidet_grad_lapl(k,j) = psidet_grad_lapl(k,j) + det_beta_grad_lapl(k,j,i)*DaC(i) - enddo - enddo - enddo - + call dgemv('N',elec_alpha_num,det_alpha_num,psidet_inv, & + det_alpha_pseudo, size(det_alpha_pseudo,1), & + CDb, 1, 0.d0, pseudo_non_local, 1) + if (elec_beta_num /= 0) then + call dgemv('N',elec_beta_num,det_beta_num,psidet_inv, & + det_beta_pseudo, size(det_beta_pseudo,1), & + DaC, 1, 0.d0, pseudo_non_local(elec_alpha_num+1), 1) + endif endif END_PROVIDER @@ -1748,7 +1688,7 @@ BEGIN_PROVIDER [ double precision, det_alpha_grad_lapl_curr, (4,elec_alpha_num) ! imo = mo_list_alpha_curr(j) ! do i=1,elec_alpha_num ! do k=1,4 -! det_alpha_grad_lapl_curr(k,i) = det_alpha_grad_lapl_curr(k,i) + mo_grad_lapl(k,i,imo)*slater_matrix_alpha_inv_det(i,j) +! det_alpha_grad_lapl_curr(k,i) = det_alpha_grad_lapl_curr(k,i) + mo_grad_lapl_alpha(k,i,imo)*slater_matrix_alpha_inv_det(i,j) ! enddo ! enddo ! enddo @@ -1905,3 +1845,27 @@ BEGIN_PROVIDER [ double precision, det_beta_grad_lapl_curr, (4,elec_alpha_num+1 END_PROVIDER + BEGIN_PROVIDER [ double precision, single_det_value ] +&BEGIN_PROVIDER [ double precision, single_det_grad, (elec_num_8,3) ] +&BEGIN_PROVIDER [ double precision, single_det_lapl, (elec_num) ] + BEGIN_DOC + ! Value of a single determinant wave function from the 1st determinant + END_DOC + det_i = 1 + det_j = 1 + integer :: i + single_det_value = det_alpha_value_curr * det_beta_value_curr + do i=1,elec_alpha_num + single_det_grad(i,1) = det_alpha_grad_lapl_curr(1,i) * det_beta_value_curr + single_det_grad(i,2) = det_alpha_grad_lapl_curr(2,i) * det_beta_value_curr + single_det_grad(i,3) = det_alpha_grad_lapl_curr(3,i) * det_beta_value_curr + single_det_lapl(i) = det_alpha_grad_lapl_curr(4,i) * det_beta_value_curr + enddo + do i=elec_alpha_num+1,elec_num + single_det_grad(i,1) = det_alpha_value_curr * det_beta_grad_lapl_curr(1,i) + single_det_grad(i,2) = det_alpha_value_curr * det_beta_grad_lapl_curr(2,i) + single_det_grad(i,3) = det_alpha_value_curr * det_beta_grad_lapl_curr(3,i) + single_det_lapl(i) = det_alpha_value_curr * det_beta_grad_lapl_curr(4,i) + enddo +END_PROVIDER +