mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-07 22:53:52 +01:00
51 lines
1.5 KiB
Fortran
51 lines
1.5 KiB
Fortran
BEGIN_PROVIDER [ double precision, lccsd_coef, (N_det, N_states)]
|
|
&BEGIN_PROVIDER [ double precision, lccsd_energies, (N_states)]
|
|
implicit none
|
|
double precision, allocatable :: Dress_jj(:), H_jj(:), u_in(:,:)
|
|
double precision :: ebefore, eafter, ecorr, thresh
|
|
integer :: i,it,degree
|
|
logical :: converged
|
|
external H_u_0_nstates_openmp
|
|
allocate(Dress_jj(N_det),H_jj(N_det),u_in(N_det,N_states_diag))
|
|
thresh = 1.d-6
|
|
converged = .False.
|
|
Dress_jj = 0.d0
|
|
u_in = 0.d0
|
|
it = 0
|
|
! initial guess
|
|
do i = 1, N_states_diag
|
|
u_in(i,i) = 1.d0
|
|
enddo
|
|
do i = 1,N_det
|
|
call i_H_j(psi_det(1,1,i),psi_det(1,1,i),N_int,H_jj(i))
|
|
enddo
|
|
ebefore = H_jj(1)
|
|
do while (.not.converged)
|
|
it += 1
|
|
print*,'N_det = ',N_det
|
|
call davidson_general_ext_rout_diag_dressed(u_in,H_jj,Dress_jj,lccsd_energies,&
|
|
N_det,N_states,N_states_diag,converged,H_u_0_nstates_openmp)
|
|
ecorr = lccsd_energies(1) - H_jj(1)
|
|
print*,'---------------------'
|
|
print*,'it = ',it
|
|
print*,'ecorr = ',ecorr
|
|
Dress_jj(1) = 0.d0
|
|
do i = 2, N_det
|
|
if(ecorr + H_jj(i) .lt. H_jj(1))then
|
|
print*,'Warning, some dets are not dressed: '
|
|
call get_excitation_degree(ref_bitmask,psi_det(1,1,i),degree,N_int)
|
|
print*,'degree, Delta E, coef', degree, H_jj(i)-H_jj(1), u_in(i,1)/u_in(1,1)
|
|
else
|
|
Dress_jj(i) = ecorr
|
|
endif
|
|
enddo
|
|
eafter = lccsd_energies(1)
|
|
converged = (dabs(eafter - ebefore).lt.thresh)
|
|
ebefore = eafter
|
|
enddo
|
|
do i = 1, N_states
|
|
lccsd_coef(1:N_det,i) = u_in(1:N_det,i)
|
|
enddo
|
|
|
|
END_PROVIDER
|