9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-07-23 02:57:24 +02:00

minor changes

This commit is contained in:
Emmanuel Giner 2020-08-07 11:47:51 +02:00
parent 2a4497d067
commit 3b75503bc1
2 changed files with 39 additions and 1 deletions

View File

@ -27,3 +27,33 @@
psi_energy_h_core(i) = psi_energy_h_core(i) * accu
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, v_ne_psi_energy, (N_states) ]
implicit none
integer :: i
integer :: j,k
double precision :: tmp(mo_num,mo_num),mono_ints(mo_num,mo_num)
BEGIN_DOC
! v_ne_psi_energy = $\langle \Psi | v_ne |\Psi \rangle$
!
! computed using the :c:data:`one_e_dm_mo_alpha` +
! :c:data:`one_e_dm_mo_beta` and :c:data:`mo_one_e_integrals`
END_DOC
v_ne_psi_energy = 0.d0
do i = 1, N_states
do j = 1, mo_num
do k = 1, mo_num
v_ne_psi_energy(i) += mo_integrals_n_e(k,j) * (one_e_dm_mo_alpha(k,j,i) + one_e_dm_mo_beta(k,j,i))
enddo
enddo
enddo
double precision :: accu
do i = 1, N_states
accu = 0.d0
do j = 1, mo_num
accu += one_e_dm_mo_alpha(j,j,i) + one_e_dm_mo_beta(j,j,i)
enddo
accu = (elec_alpha_num + elec_beta_num ) / accu
v_ne_psi_energy(i) = v_ne_psi_energy(i) * accu
enddo
END_PROVIDER

View File

@ -30,7 +30,11 @@ subroutine give_explicit_poly_and_gaussian_x(P_new,P_center,p,fact_k,iorder,alph
ab = alpha * beta
d_AB = (A_center - B_center) * (A_center - B_center)
P_center = (alpha * A_center + beta * B_center) * p_inv
fact_k = exp(-ab*p_inv * d_AB)
if(dabs(ab*p_inv * d_AB).lt.50.d0)then
fact_k = exp(-ab*p_inv * d_AB)
else
fact_k = 0.d0
endif
! Recenter the polynomials P_a and P_b on x
!DIR$ FORCEINLINE
@ -78,6 +82,10 @@ subroutine give_explicit_poly_and_gaussian(P_new,P_center,p,fact_k,iorder,alpha,
!DIR$ FORCEINLINE
call gaussian_product(alpha,A_center,beta,B_center,fact_k,p,P_center)
if (fact_k < thresh) then
P_center = 0.d0
p = 1.d-10
P_new = 0.d0
iorder = -1
fact_k = 0.d0
return
endif