mirror of
https://github.com/LCPQ/quantum_package
synced 2024-11-13 09:34:02 +01:00
Fixed bugs in dressing
This commit is contained in:
parent
7ccd2c962c
commit
b65846597a
@ -7,7 +7,7 @@ interface: ezfio, provider
|
||||
[slater_coef_ezfio]
|
||||
type: double precision
|
||||
doc: Exponents of the additional Slater functions
|
||||
size: (mo_basis.mo_tot_num,nuclei.nucl_num)
|
||||
size: (nuclei.nucl_num,mo_basis.mo_tot_num)
|
||||
interface: ezfio, provider
|
||||
|
||||
|
||||
|
@ -11,8 +11,8 @@ BEGIN_PROVIDER [ double precision, cusp_A, (nucl_num, nucl_num) ]
|
||||
cusp_A(A,A) = slater_expo(A)/nucl_charge(A) * slater_value_at_nucl(A,A)
|
||||
do B=1,nucl_num
|
||||
cusp_A(A,B) -= slater_value_at_nucl(B,A)
|
||||
do mu=1,ao_num
|
||||
cusp_A(A,B) += GauSlaOverlap_matrix(mu,B) * ao_value_at_nucl(mu,A)
|
||||
do mu=1,mo_tot_num
|
||||
cusp_A(A,B) += MOSlaOverlap_matrix(mu,B) * mo_value_at_nucl(mu,A)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
@ -26,7 +26,7 @@ end
|
||||
|
||||
subroutine debug
|
||||
implicit none
|
||||
integer :: i
|
||||
integer :: i,j,k
|
||||
print *, 'A'
|
||||
do i=1,nucl_num
|
||||
print *, i, cusp_A(1:nucl_num, i)
|
||||
@ -35,10 +35,32 @@ subroutine debug
|
||||
do i=1,mo_tot_num
|
||||
print *, i, cusp_B(1:nucl_num, i)
|
||||
enddo
|
||||
print *, 'C'
|
||||
print *, 'X'
|
||||
do i=1,mo_tot_num
|
||||
print *, i, cusp_C(1:nucl_num, i)
|
||||
enddo
|
||||
print *, '-----'
|
||||
return
|
||||
do k=-100,100
|
||||
double precision :: x, y, z
|
||||
x = 0.01d0 * k
|
||||
y = 0.d0
|
||||
do i=1,ao_num
|
||||
z = 0.d0
|
||||
do j=1,ao_prim_num(i)
|
||||
z += ao_coef_normalized_ordered_transp(j,i) * dexp(-ao_expo_ordered_transp(j,i) * x**2)
|
||||
enddo
|
||||
y += mo_coef(i,1) * z
|
||||
y += exp(-slater_expo(1)*dabs(x)) * slater_coef(1,1)
|
||||
z = 0.d0
|
||||
do j=1,ao_prim_num(i)
|
||||
z += ao_coef_normalized_ordered_transp(j,i) * dexp(-ao_expo_ordered_transp(j,i) * x**2)
|
||||
enddo
|
||||
y -= z * GauSlaOverlap_matrix(i,1)* slater_coef(1,1)
|
||||
enddo
|
||||
print *, x, y
|
||||
enddo
|
||||
print *, '-----'
|
||||
end
|
||||
|
||||
subroutine run
|
||||
@ -58,7 +80,7 @@ subroutine run
|
||||
|
||||
mo_label = "CuspDressed"
|
||||
|
||||
call ezfio_set_Hartree_Fock_SlaterDressed_slater_coef_ezfio(cusp_B)
|
||||
call ezfio_set_Hartree_Fock_SlaterDressed_slater_coef_ezfio(cusp_C)
|
||||
! Choose SCF algorithm
|
||||
|
||||
|
||||
|
@ -51,13 +51,14 @@ BEGIN_PROVIDER [ double precision , slater_value_at_nucl, (nucl_num,nucl_num) ]
|
||||
|
||||
do k=1,nucl_num
|
||||
do i=1,nucl_num
|
||||
x = nucl_coord(ao_nucl(i),1) - nucl_coord(k,1)
|
||||
y = nucl_coord(ao_nucl(i),2) - nucl_coord(k,2)
|
||||
z = nucl_coord(ao_nucl(i),3) - nucl_coord(k,3)
|
||||
x = nucl_coord(i,1) - nucl_coord(k,1)
|
||||
y = nucl_coord(i,2) - nucl_coord(k,2)
|
||||
z = nucl_coord(i,3) - nucl_coord(k,3)
|
||||
|
||||
expo = slater_expo(i)*slater_expo(i)*((x*x) + (y*y) + (z*z))
|
||||
if (expo > 160.d0) cycle
|
||||
expo = dsqrt(expo)
|
||||
! expo = slater_expo(i)*slater_expo(i)*((x*x) + (y*y) + (z*z))
|
||||
! if (expo > 160.d0) cycle
|
||||
! expo = dsqrt(expo)
|
||||
expo = slater_expo(i) * dsqrt((x*x) + (y*y) + (z*z))
|
||||
slater_value_at_nucl(i,k) = dexp(-expo) * slater_normalization(i)
|
||||
enddo
|
||||
enddo
|
||||
|
@ -321,3 +321,14 @@ BEGIN_PROVIDER [ double precision, GauSlaOverlap_matrix, (ao_num, nucl_num) ]
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, MOSlaOverlap_matrix, (mo_tot_num, nucl_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! <MO | Slater>
|
||||
END_DOC
|
||||
call dgemm('N','N',mo_tot_num,nucl_num,ao_num,1.d0, &
|
||||
mo_coef_transp, size(mo_coef_transp,1), &
|
||||
GauSlaOverlap_matrix, size(GauSlaOverlap_matrix,1), &
|
||||
0.d0, MOSlaOverlap_matrix, size(MOSlaOverlap_matrix,1))
|
||||
END_PROVIDER
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user