mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 12:56:14 +01:00
528 lines
15 KiB
Fortran
528 lines
15 KiB
Fortran
subroutine all_single
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision,allocatable :: E_before(:)
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
|
selection_criterion = 0.d0
|
|
soft_touch selection_criterion
|
|
threshold_davidson = 1.d-9
|
|
soft_touch threshold_davidson davidson_criterion
|
|
i = 0
|
|
print*,'Doing all the mono excitations !'
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
print*,'N_det_generators = ',N_det_generators
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
|
|
print*,'Initial Step '
|
|
print*,'Inital determinants '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
n_det_max = 100000
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_just_mono(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
if(N_states_diag.gt.1)then
|
|
print*,'Variational Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
|
enddo
|
|
endif
|
|
if(N_states.gt.1)then
|
|
print*,'Variational + perturbative Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
|
|
enddo
|
|
endif
|
|
E_before = CI_energy
|
|
!!!!!!!!!!!!!!!!!!!!!!!!!!! DOING ONLY ONE ITERATION OF SELECTION AS THE SELECTION CRITERION IS SET TO ZERO
|
|
exit
|
|
enddo
|
|
! threshold_davidson = 1.d-8
|
|
! soft_touch threshold_davidson davidson_criterion
|
|
! call diagonalize_CI
|
|
print*,'Final Step '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
do i = 1, max(2,N_det_generators)
|
|
print*,'psi_coef = ',psi_coef(i,1)
|
|
enddo
|
|
deallocate(pt2,norm_pert,E_before)
|
|
end
|
|
|
|
subroutine all_1h2p
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision,allocatable :: E_before(:)
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
|
selection_criterion = 0.d0
|
|
soft_touch selection_criterion
|
|
threshold_davidson = 1.d-5
|
|
soft_touch threshold_davidson davidson_criterion
|
|
i = 0
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,'*****************************'
|
|
print*,'Doing all the 1h2P excitations'
|
|
print*,'*****************************'
|
|
print*,''
|
|
print*,''
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
print*,'N_det_generators = ',N_det_generators
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
|
|
print*,'Initial Step '
|
|
print*,'Inital determinants '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
n_det_max = 100000
|
|
i = 0
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_only_1h2p(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
if(N_states_diag.gt.1)then
|
|
print*,'Variational Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
|
enddo
|
|
endif
|
|
if(N_states.gt.1)then
|
|
print*,'Variational + perturbative Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
|
|
enddo
|
|
endif
|
|
E_before = CI_energy
|
|
|
|
enddo
|
|
print*,'Final Step '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
|
|
do i = 1, 2
|
|
print*,'psi_coef = ',psi_coef(i,1)
|
|
enddo
|
|
deallocate(pt2,norm_pert,E_before)
|
|
end
|
|
|
|
subroutine all_2h2p
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision,allocatable :: E_before(:)
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
|
selection_criterion = 0.d0
|
|
soft_touch selection_criterion
|
|
threshold_davidson = 1.d-5
|
|
soft_touch threshold_davidson davidson_criterion
|
|
i = 0
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,'*****************************'
|
|
print*,'Doing all the 2h2P excitations'
|
|
print*,'*****************************'
|
|
print*,''
|
|
print*,''
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
print*,'N_det_generators = ',N_det_generators
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
|
|
print*,'Initial Step '
|
|
print*,'Inital determinants '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
n_det_max = 100000
|
|
i = 0
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_only_2h2p(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
if(N_states_diag.gt.1)then
|
|
print*,'Variational Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
|
enddo
|
|
endif
|
|
if(N_states.gt.1)then
|
|
print*,'Variational + perturbative Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
|
|
enddo
|
|
endif
|
|
E_before = CI_energy
|
|
|
|
enddo
|
|
print*,'Final Step '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
do i = 1, 2
|
|
print*,'psi_coef = ',psi_coef(i,1)
|
|
enddo
|
|
deallocate(pt2,norm_pert,E_before)
|
|
end
|
|
|
|
subroutine all_2p
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision,allocatable :: E_before(:)
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
|
selection_criterion = 0.d0
|
|
soft_touch selection_criterion
|
|
threshold_davidson = 1.d-5
|
|
soft_touch threshold_davidson davidson_criterion
|
|
i = 0
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,''
|
|
print*,'*****************************'
|
|
print*,'Doing all the 2P excitations'
|
|
print*,'*****************************'
|
|
print*,''
|
|
print*,''
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
print*,'N_det_generators = ',N_det_generators
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
|
|
print*,'Initial Step '
|
|
print*,'Inital determinants '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
n_det_max = 100000
|
|
i = 0
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_only_2p(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
if(N_states_diag.gt.1)then
|
|
print*,'Variational Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
|
enddo
|
|
endif
|
|
if(N_states.gt.1)then
|
|
print*,'Variational + perturbative Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
|
|
enddo
|
|
endif
|
|
E_before = CI_energy
|
|
|
|
enddo
|
|
print*,'Final Step '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
deallocate(pt2,norm_pert,E_before)
|
|
do i = 1, 2
|
|
print*,'psi_coef = ',psi_coef(i,1)
|
|
enddo
|
|
end
|
|
|
|
subroutine all_single_no_1h_or_1p
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision,allocatable :: E_before(:)
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
|
selection_criterion = 0.d0
|
|
soft_touch selection_criterion
|
|
threshold_davidson = 1.d-5
|
|
soft_touch threshold_davidson davidson_criterion
|
|
i = 0
|
|
print*,'Doing all the mono excitations !'
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
print*,'N_det_generators = ',N_det_generators
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
|
|
print*,'Initial Step '
|
|
print*,'Inital determinants '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
n_det_max = 100000
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_just_mono_no_1h_no_1p(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
if(N_states_diag.gt.1)then
|
|
print*,'Variational Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
|
enddo
|
|
endif
|
|
if(N_states.gt.1)then
|
|
print*,'Variational + perturbative Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
|
|
enddo
|
|
endif
|
|
E_before = CI_energy
|
|
enddo
|
|
threshold_davidson = 1.d-16
|
|
soft_touch threshold_davidson davidson_criterion
|
|
call diagonalize_CI
|
|
print*,'Final Step '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
do i = 1, 2
|
|
print*,'psi_coef = ',psi_coef(i,1)
|
|
enddo
|
|
! call save_wavefunction
|
|
deallocate(pt2,norm_pert,E_before)
|
|
end
|
|
|
|
subroutine all_single_no_1h_or_1p_or_2p
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision,allocatable :: E_before(:)
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st),E_before(N_st))
|
|
selection_criterion = 0.d0
|
|
soft_touch selection_criterion
|
|
threshold_davidson = 1.d-5
|
|
soft_touch threshold_davidson davidson_criterion
|
|
i = 0
|
|
print*,'Doing all the mono excitations !'
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
print*,'N_det_generators = ',N_det_generators
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
|
|
print*,'Initial Step '
|
|
print*,'Inital determinants '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
n_det_max = 100000
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_just_mono_no_1h_no_1p_no_2p(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
if(N_states_diag.gt.1)then
|
|
print*,'Variational Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',CI_energy(i) - CI_energy(1)
|
|
enddo
|
|
endif
|
|
if(N_states.gt.1)then
|
|
print*,'Variational + perturbative Energy difference'
|
|
do i = 2, N_st
|
|
print*,'Delta E = ',E_before(i)+ pt2(i) - (E_before(1) + pt2(1))
|
|
enddo
|
|
endif
|
|
E_before = CI_energy
|
|
enddo
|
|
threshold_davidson = 1.d-10
|
|
soft_touch threshold_davidson davidson_criterion
|
|
call diagonalize_CI
|
|
print*,'Final Step '
|
|
print*,'N_det = ',N_det
|
|
do i = 1, N_states_diag
|
|
print*,''
|
|
print*,'i = ',i
|
|
print*,'E = ',CI_energy(i)
|
|
print*,'S^2 = ',CI_eigenvectors_s2(i)
|
|
enddo
|
|
do i = 1, 2
|
|
print*,'psi_coef = ',psi_coef(i,1)
|
|
enddo
|
|
! call save_wavefunction
|
|
deallocate(pt2,norm_pert,E_before)
|
|
end
|
|
|
|
subroutine all_1h_1p_routine
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision :: E_before
|
|
integer :: n_det_before
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
|
|
i = 0
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
n_det_before = N_det
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_just_1h_1p(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
E_before = CI_energy(1)
|
|
if(n_det_before == N_det)then
|
|
selection_criterion = selection_criterion * 0.5d0
|
|
endif
|
|
enddo
|
|
deallocate(pt2,norm_pert)
|
|
end
|
|
subroutine all_but_1h_1p_routine
|
|
implicit none
|
|
integer :: i,k
|
|
double precision, allocatable :: pt2(:), norm_pert(:), H_pert_diag(:)
|
|
integer :: N_st, degree
|
|
double precision :: E_before
|
|
integer :: n_det_before
|
|
N_st = N_states
|
|
allocate (pt2(N_st), norm_pert(N_st),H_pert_diag(N_st))
|
|
i = 0
|
|
print*,'N_det = ',N_det
|
|
print*,'n_det_max = ',n_det_max
|
|
print*,'pt2_max = ',pt2_max
|
|
pt2=-1.d0
|
|
E_before = ref_bitmask_energy
|
|
do while (N_det < n_det_max.and.maxval(abs(pt2(1:N_st))) > pt2_max)
|
|
n_det_before = N_det
|
|
i += 1
|
|
print*,'-----------------------'
|
|
print*,'i = ',i
|
|
call H_apply_all_but_1h_and_1p(pt2, norm_pert, H_pert_diag, N_st)
|
|
call diagonalize_CI
|
|
print*,'N_det = ',N_det
|
|
print*,'E = ',CI_energy(1)
|
|
print*,'pt2 = ',pt2(1)
|
|
print*,'E+PT2 = ',E_before + pt2(1)
|
|
E_before = CI_energy(1)
|
|
if(n_det_before == N_det)then
|
|
selection_criterion = selection_criterion * 0.5d0
|
|
endif
|
|
enddo
|
|
deallocate(pt2,norm_pert)
|
|
end
|