mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Improved Hartree-Fock
This commit is contained in:
parent
3beea8d230
commit
42d8b4c404
@ -93,46 +93,6 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_overlap, (ao_num_align,ao_num) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! matrix of the overlap for tha AOs
|
|
||||||
! S(i,j) = overlap between the ith and the jth atomic basis function
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,k,l,nz,num_i,num_j,powA(3),powB(3)
|
|
||||||
double precision :: accu,overlap_x,overlap_y,overlap_z,A_center(3),B_center(3),norm
|
|
||||||
nz=100
|
|
||||||
do i = 1, ao_num
|
|
||||||
num_i = ao_nucl(i)
|
|
||||||
powA(1) = ao_power(i,1)
|
|
||||||
powA(2) = ao_power(i,2)
|
|
||||||
powA(3) = ao_power(i,3)
|
|
||||||
A_center(1)=nucl_coord(num_i,1)
|
|
||||||
A_center(2)=nucl_coord(num_i,2)
|
|
||||||
A_center(3)=nucl_coord(num_i,3)
|
|
||||||
do j = i, ao_num
|
|
||||||
num_j = ao_nucl(j)
|
|
||||||
powB(1) = ao_power(j,1)
|
|
||||||
powB(2) = ao_power(j,2)
|
|
||||||
powB(3) = ao_power(j,3)
|
|
||||||
B_center(1)=nucl_coord(num_j,1)
|
|
||||||
B_center(2)=nucl_coord(num_j,2)
|
|
||||||
B_center(3)=nucl_coord(num_j,3)
|
|
||||||
accu = 0.d0
|
|
||||||
do k = 1, ao_prim_num(i)
|
|
||||||
do l = 1, ao_prim_num(j)
|
|
||||||
call overlap_gaussian_xyz(A_center,B_center,ao_expo(i,k),ao_expo(j,l),powA,powB,overlap_x,overlap_y,overlap_z,norm,nz)
|
|
||||||
accu = accu + norm * ao_coef(i,k) * ao_coef(j,l)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
ao_overlap(i,j) = accu
|
|
||||||
ao_overlap(j,i) = accu
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_coef_transp, (ao_prim_num_max_align,ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_coef_transp, (ao_prim_num_max_align,ao_num) ]
|
||||||
&BEGIN_PROVIDER [ double precision, ao_expo_transp, (ao_prim_num_max_align,ao_num) ]
|
&BEGIN_PROVIDER [ double precision, ao_expo_transp, (ao_prim_num_max_align,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -5,13 +5,13 @@
|
|||||||
! Alpha and Beta density matrix in the AO basis
|
! Alpha and Beta density matrix in the AO basis
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k,l1,l2
|
integer :: i,j,k,l1,l2
|
||||||
integer, allocatable :: mo_occ(:,:)
|
integer, allocatable :: occ(:,:)
|
||||||
|
|
||||||
allocate ( mo_occ(elec_alpha_num,2) )
|
allocate ( occ(elec_alpha_num,2) )
|
||||||
call bitstring_to_list( HF_bitmask(1,1), mo_occ(1,1), j, N_int)
|
call bitstring_to_list( HF_bitmask(1,1), occ(1,1), j, N_int)
|
||||||
ASSERT ( j==elec_alpha_num )
|
ASSERT ( j==elec_alpha_num )
|
||||||
|
|
||||||
call bitstring_to_list( HF_bitmask(1,2), mo_occ(1,2), j, N_int)
|
call bitstring_to_list( HF_bitmask(1,2), occ(1,2), j, N_int)
|
||||||
ASSERT ( j==elec_beta_num )
|
ASSERT ( j==elec_beta_num )
|
||||||
|
|
||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
@ -21,8 +21,8 @@
|
|||||||
HF_density_matrix_ao_beta (i,j) = 0.d0
|
HF_density_matrix_ao_beta (i,j) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
do k=1,elec_beta_num
|
do k=1,elec_beta_num
|
||||||
l1 = mo_occ(k,1)
|
l1 = occ(k,1)
|
||||||
l2 = mo_occ(k,2)
|
l2 = occ(k,2)
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
HF_density_matrix_ao_alpha(i,j) = HF_density_matrix_ao_alpha(i,j) +&
|
HF_density_matrix_ao_alpha(i,j) = HF_density_matrix_ao_alpha(i,j) +&
|
||||||
@ -32,7 +32,7 @@
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
do k=elec_beta_num+1,elec_alpha_num
|
do k=elec_beta_num+1,elec_alpha_num
|
||||||
l1 = mo_occ(k,1)
|
l1 = occ(k,1)
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
HF_density_matrix_ao_alpha(i,j) = HF_density_matrix_ao_alpha(i,j) +&
|
HF_density_matrix_ao_alpha(i,j) = HF_density_matrix_ao_alpha(i,j) +&
|
||||||
@ -40,7 +40,7 @@
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
deallocate(mo_occ)
|
deallocate(occ)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, HF_density_matrix_ao, (ao_num_align,ao_num) ]
|
BEGIN_PROVIDER [ double precision, HF_density_matrix_ao, (ao_num_align,ao_num) ]
|
||||||
@ -49,13 +49,13 @@ BEGIN_PROVIDER [ double precision, HF_density_matrix_ao, (ao_num_align,ao_num) ]
|
|||||||
! Density matrix in the AO basis
|
! Density matrix in the AO basis
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k,l1,l2
|
integer :: i,j,k,l1,l2
|
||||||
integer, allocatable :: mo_occ(:,:)
|
integer, allocatable :: occ(:,:)
|
||||||
|
|
||||||
allocate ( mo_occ(elec_alpha_num,2) )
|
allocate ( occ(elec_alpha_num,2) )
|
||||||
call bitstring_to_list( HF_bitmask(1,1), mo_occ(1,1), j, N_int)
|
call bitstring_to_list( HF_bitmask(1,1), occ(1,1), j, N_int)
|
||||||
ASSERT ( j==elec_alpha_num )
|
ASSERT ( j==elec_alpha_num )
|
||||||
|
|
||||||
call bitstring_to_list( HF_bitmask(1,2), mo_occ(1,2), j, N_int)
|
call bitstring_to_list( HF_bitmask(1,2), occ(1,2), j, N_int)
|
||||||
ASSERT ( j==elec_beta_num )
|
ASSERT ( j==elec_beta_num )
|
||||||
|
|
||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
@ -64,8 +64,8 @@ BEGIN_PROVIDER [ double precision, HF_density_matrix_ao, (ao_num_align,ao_num) ]
|
|||||||
HF_density_matrix_ao(i,j) = 0.d0
|
HF_density_matrix_ao(i,j) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
do k=1,elec_beta_num
|
do k=1,elec_beta_num
|
||||||
l1 = mo_occ(k,1)
|
l1 = occ(k,1)
|
||||||
l2 = mo_occ(k,2)
|
l2 = occ(k,2)
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
HF_density_matrix_ao(i,j) = HF_density_matrix_ao(i,j) + &
|
HF_density_matrix_ao(i,j) = HF_density_matrix_ao(i,j) + &
|
||||||
@ -74,7 +74,7 @@ BEGIN_PROVIDER [ double precision, HF_density_matrix_ao, (ao_num_align,ao_num) ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
do k=elec_beta_num+1,elec_alpha_num
|
do k=elec_beta_num+1,elec_alpha_num
|
||||||
l1 = mo_occ(k,1)
|
l1 = occ(k,1)
|
||||||
!DIR$ VECTOR ALIGNED
|
!DIR$ VECTOR ALIGNED
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
HF_density_matrix_ao(i,j) = HF_density_matrix_ao(i,j) + &
|
HF_density_matrix_ao(i,j) = HF_density_matrix_ao(i,j) + &
|
||||||
@ -82,6 +82,6 @@ BEGIN_PROVIDER [ double precision, HF_density_matrix_ao, (ao_num_align,ao_num) ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
deallocate(mo_occ)
|
deallocate(occ)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -3,21 +3,55 @@ program scf_iteration
|
|||||||
implicit none
|
implicit none
|
||||||
double precision :: SCF_energy_before,SCF_energy_after,diag_H_mat_elem,get_mo_bielec_integral
|
double precision :: SCF_energy_before,SCF_energy_after,diag_H_mat_elem,get_mo_bielec_integral
|
||||||
double precision :: E0
|
double precision :: E0
|
||||||
integer :: i_it
|
integer :: i_it, i, j, k
|
||||||
|
integer, allocatable :: iorder(:)
|
||||||
|
double precision, allocatable :: DM_occ(:,:), E_new(:), R(:,:)
|
||||||
|
|
||||||
E0 = HF_energy
|
E0 = HF_energy
|
||||||
i_it = 0
|
i_it = 1
|
||||||
n_it_scf_max = 10
|
n_it_scf_max = 100
|
||||||
SCF_energy_before = huge(1.d0)
|
SCF_energy_before = 0.d0
|
||||||
SCF_energy_after = E0
|
SCF_energy_after = E0
|
||||||
print *, E0
|
print *, E0
|
||||||
mo_label = "Canonical"
|
mo_label = "Canonical"
|
||||||
thresh_SCF = 1.d-10
|
thresh_SCF = 1.d-10
|
||||||
do while (i_it < 40 .and. dabs(SCF_energy_before - SCF_energy_after) > thresh_SCF)
|
DM_occ = mo_density_matrix
|
||||||
SCF_energy_before = SCF_energy_after
|
allocate (DM_occ(size(mo_density_matrix,1),mo_tot_num), &
|
||||||
mo_coef = eigenvectors_Fock_matrix_mo
|
E_new(mo_tot_num), R(mo_tot_num,mo_tot_num), iorder(mo_tot_num))
|
||||||
TOUCH mo_coef mo_label
|
do while (i_it < n_it_scf_max .and. dabs(SCF_energy_before - SCF_energy_after) > thresh_SCF)
|
||||||
|
if (SCF_energy_after <= SCF_energy_before+1.d-4) then
|
||||||
|
mo_coef = eigenvectors_Fock_matrix_mo
|
||||||
|
TOUCH mo_coef mo_label
|
||||||
|
DM_occ = mo_density_matrix
|
||||||
|
else
|
||||||
|
DM_occ = mo_density_matrix
|
||||||
|
mo_coef = eigenvectors_Fock_matrix_mo
|
||||||
|
TOUCH mo_coef mo_label mo_integrals_map
|
||||||
|
DM_occ = DM_occ + 0.0d0*mo_density_matrix
|
||||||
|
integer :: rank
|
||||||
|
call cholesky_mo(ao_num,mo_tot_num,DM_occ,size(DM_occ,1),mo_coef,size(mo_coef,1),-1.d0,rank)
|
||||||
|
print *, rank
|
||||||
|
TOUCH mo_coef mo_label
|
||||||
|
call orthonormalize_mos
|
||||||
|
call find_rotation(eigenvectors_Fock_matrix_mo,mo_tot_num_align,mo_coef,ao_num,R, mo_tot_num)
|
||||||
|
do i=1,mo_tot_num
|
||||||
|
iorder(i) = i
|
||||||
|
E_new(i) = 0.d0
|
||||||
|
do k=1,mo_tot_num
|
||||||
|
E_new(i) += R(k,i)*R(k,i)*diagonal_fock_matrix_mo(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call dsort(E_new(1),iorder(1),mo_tot_num)
|
||||||
|
eigenvectors_Fock_matrix_mo = mo_coef
|
||||||
|
do j=1,mo_tot_num
|
||||||
|
do i=1,ao_num
|
||||||
|
mo_coef(i,j) = eigenvectors_Fock_matrix_mo(i,iorder(j))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
TOUCH mo_coef mo_label mo_integrals_map
|
||||||
|
endif
|
||||||
call clear_mo_map
|
call clear_mo_map
|
||||||
|
SCF_energy_before = SCF_energy_after
|
||||||
SCF_energy_after = HF_energy
|
SCF_energy_after = HF_energy
|
||||||
print*,SCF_energy_after, dabs(SCF_energy_before - SCF_energy_after)
|
print*,SCF_energy_after, dabs(SCF_energy_before - SCF_energy_after)
|
||||||
i_it +=1
|
i_it +=1
|
||||||
@ -31,6 +65,7 @@ program scf_iteration
|
|||||||
stop 'Failed'
|
stop 'Failed'
|
||||||
endif
|
endif
|
||||||
mo_label = "Canonical"
|
mo_label = "Canonical"
|
||||||
|
deallocate (DM_occ)
|
||||||
TOUCH mo_label mo_coef
|
TOUCH mo_label mo_coef
|
||||||
call save_mos
|
call save_mos
|
||||||
|
|
||||||
|
@ -1,11 +1,11 @@
|
|||||||
subroutine cholesky_mo(n,m,P,C,LDC,tol_in,rank)
|
subroutine cholesky_mo(n,m,P,LDP,C,LDC,tol_in,rank)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Cholesky decomposition of MO Density matrix to
|
! Cholesky decomposition of MO Density matrix to
|
||||||
! generate MOs
|
! generate MOs
|
||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: n,m, LDC
|
integer, intent(in) :: n,m, LDC, LDP
|
||||||
double precision, intent(in) :: P(LDC,n)
|
double precision, intent(in) :: P(LDP,n)
|
||||||
double precision, intent(out) :: C(LDC,m)
|
double precision, intent(out) :: C(LDC,m)
|
||||||
double precision, intent(in) :: tol_in
|
double precision, intent(in) :: tol_in
|
||||||
integer, intent(out) :: rank
|
integer, intent(out) :: rank
|
||||||
@ -49,7 +49,7 @@ BEGIN_PROVIDER [ double precision, mo_density_matrix, (mo_tot_num_align, mo_tot_
|
|||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
mo_density_matrix = 0.d0
|
mo_density_matrix = 0.d0
|
||||||
do k=1,mo_tot_num
|
do k=1,mo_tot_num
|
||||||
if (mo_occ(k) == 0) then
|
if (mo_occ(k) == 0.d0) then
|
||||||
cycle
|
cycle
|
||||||
endif
|
endif
|
||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
@ -67,14 +67,11 @@ BEGIN_PROVIDER [ double precision, mo_density_matrix_virtual, (mo_tot_num_align,
|
|||||||
! Density matrix in MO basis (virtual MOs)
|
! Density matrix in MO basis (virtual MOs)
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
mo_density_matrix = 0.d0
|
mo_density_matrix_virtual = 0.d0
|
||||||
do k=1,mo_tot_num
|
do k=1,mo_tot_num
|
||||||
if (mo_occ(k) == 0) then
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
mo_density_matrix(i,j) = mo_density_matrix(i,j) + &
|
mo_density_matrix_virtual(i,j) = mo_density_matrix_virtual(i,j) + &
|
||||||
(2.d0-mo_occ(k)) * mo_coef(i,k) * mo_coef(j,k)
|
(2.d0-mo_occ(k)) * mo_coef(i,k) * mo_coef(j,k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
Loading…
Reference in New Issue
Block a user