10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 12:23:48 +01:00

simple untested minilist for all perturbations

This commit is contained in:
Yann Garniron 2015-11-19 17:16:24 +01:00
parent 132c74e60b
commit 54ec552c14
8 changed files with 94 additions and 17 deletions

View File

@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32
# 0 : Deactivate # 0 : Deactivate
# #
[OPTION] [OPTION]
MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below
CACHE : 1 ; Enable cache_compile.py CACHE : 1 ; Enable cache_compile.py
OPENMP : 1 ; Append OpenMP flags OPENMP : 1 ; Append OpenMP flags

View File

@ -31,7 +31,8 @@ subroutine pt2_moller_plesset(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_s
(Fock_matrix_diag_mo(p1) + Fock_matrix_diag_mo(p2)) (Fock_matrix_diag_mo(p1) + Fock_matrix_diag_mo(p2))
delta_e = 1.d0/delta_e delta_e = 1.d0/delta_e
call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array) !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array)
call i_H_psi_nominilist(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det,psi_selectors_size,n_st,i_H_psi_array)
h = diag_H_mat_elem(det_pert,Nint) h = diag_H_mat_elem(det_pert,Nint)
do i =1,n_st do i =1,n_st
H_pert_diag(i) = h H_pert_diag(i) = h

View File

@ -1,4 +1,4 @@
subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st) subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,n_st integer, intent(in) :: Nint,ndet,n_st
@ -7,6 +7,10 @@ subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,nde
double precision :: i_O1_psi_array(N_st) double precision :: i_O1_psi_array(N_st)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the perturbatibe contribution to the Integrated Spin density at z = z_one point of one determinant ! compute the perturbatibe contribution to the Integrated Spin density at z = z_one point of one determinant
! !
@ -46,7 +50,8 @@ subroutine pt2_delta_rho_one_point(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,nde
! endif ! endif
call i_O1_psi_alpha_beta(mo_integrated_delta_rho_one_point,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array) call i_O1_psi_alpha_beta(mo_integrated_delta_rho_one_point,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array)
call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
h = diag_H_mat_elem(det_pert,Nint) h = diag_H_mat_elem(det_pert,Nint)
oii = diag_O1_mat_elem_alpha_beta(mo_integrated_delta_rho_one_point,det_pert,N_int) oii = diag_O1_mat_elem_alpha_beta(mo_integrated_delta_rho_one_point,det_pert,N_int)

View File

@ -1,4 +1,4 @@
subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st) subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,n_st integer, intent(in) :: Nint,ndet,n_st
@ -7,6 +7,10 @@ subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_
double precision :: i_O1_psi_array(N_st) double precision :: i_O1_psi_array(N_st)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the perturbatibe contribution to the dipole moment of one determinant ! compute the perturbatibe contribution to the dipole moment of one determinant
! !
@ -46,7 +50,9 @@ subroutine pt2_dipole_moment_z(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_
! endif ! endif
call i_O1_psi(mo_dipole_z,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array) call i_O1_psi(mo_dipole_z,det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_O1_psi_array)
call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
h = diag_H_mat_elem(det_pert,Nint) h = diag_H_mat_elem(det_pert,Nint)
oii = diag_O1_mat_elem(mo_dipole_z,det_pert,N_int) oii = diag_O1_mat_elem(mo_dipole_z,det_pert,N_int)

View File

@ -1,4 +1,4 @@
subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st) subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,N_st integer, intent(in) :: Nint,ndet,N_st
@ -6,6 +6,10 @@ subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_s
double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st) double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution ! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
! !
@ -23,7 +27,10 @@ subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_s
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
ASSERT (Nint > 0) ASSERT (Nint > 0)
call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
h = diag_H_mat_elem(det_pert,Nint) h = diag_H_mat_elem(det_pert,Nint)
do i =1,N_st do i =1,N_st
if(CI_electronic_energy(i)>h.and.CI_electronic_energy(i).ne.0.d0)then if(CI_electronic_energy(i)>h.and.CI_electronic_energy(i).ne.0.d0)then
@ -45,11 +52,15 @@ end
subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist) subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,N_st, idx_minilist(0:N_det_selectors), N_minilist integer, intent(in) :: Nint,ndet,N_st
integer(bit_kind), intent(in) :: det_pert(Nint,2), minilist(Nint,2,N_det_selectors) integer(bit_kind), intent(in) :: det_pert(Nint,2)
double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st) double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the Epstein-Nesbet 2x2 diagonalization coefficient and energetic contribution ! compute the Epstein-Nesbet 2x2 diagonalization coefficient and energetic contribution
! !

View File

@ -1,5 +1,5 @@
subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st) subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,N_st integer, intent(in) :: Nint,ndet,N_st
@ -8,6 +8,10 @@ subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer :: idx_repeat(0:ndet) integer :: idx_repeat(0:ndet)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution ! compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
! !
@ -84,7 +88,7 @@ subroutine pt2_epstein_nesbet_SC2_projected(det_pert,c_pert,e_2_pert,H_pert_diag
end end
subroutine pt2_epstein_nesbet_SC2_no_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st) subroutine pt2_epstein_nesbet_SC2_no_projected(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,N_st integer, intent(in) :: Nint,ndet,N_st
@ -93,6 +97,10 @@ subroutine pt2_epstein_nesbet_SC2_no_projected(det_pert,c_pert,e_2_pert,H_pert_d
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer :: idx_repeat(0:ndet) integer :: idx_repeat(0:ndet)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution ! compute the Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
! !
@ -183,7 +191,7 @@ double precision function repeat_all_e_corr(key_in)
end end
subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st) subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,N_st integer, intent(in) :: Nint,ndet,N_st
@ -191,6 +199,10 @@ subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet
double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st) double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution ! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
! !
@ -208,7 +220,10 @@ subroutine pt2_epstein_nesbet_sc2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
ASSERT (Nint > 0) ASSERT (Nint > 0)
call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array)
call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array)
h = diag_H_mat_elem(det_pert,Nint) h = diag_H_mat_elem(det_pert,Nint)
do i =1,N_st do i =1,N_st
if(CI_SC2_electronic_energy(i)>h.and.CI_SC2_electronic_energy(i).ne.0.d0)then if(CI_SC2_electronic_energy(i)>h.and.CI_SC2_electronic_energy(i).ne.0.d0)then

View File

@ -1,4 +1,4 @@
subroutine pt2_h_core(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st) subroutine pt2_h_core(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint,ndet,N_st integer, intent(in) :: Nint,ndet,N_st
@ -6,6 +6,10 @@ subroutine pt2_h_core(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st)
double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st) double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st)
double precision :: i_H_psi_array(N_st) double precision :: i_H_psi_array(N_st)
integer, intent(in) :: N_minilist
integer, intent(in) :: idx_minilist(0:N_det_selectors)
integer(bit_kind), intent(in) :: minilist(Nint,2,N_det_selectors)
BEGIN_DOC BEGIN_DOC
! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution ! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
! !

View File

@ -810,8 +810,43 @@ subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullLis
end do end do
end subroutine end subroutine
!call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) subroutine i_H_psi_nominilist(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
call i_H_psi(det_pert,minilist,idx_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) use bitmasks
implicit none
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
integer(bit_kind), intent(in) :: key(Nint,2)
double precision, intent(in) :: coef(Ndet_max,Nstate)
double precision, intent(out) :: i_H_psi_array(Nstate)
integer :: i, ii,j
double precision :: phase
integer :: exc(0:2,2,2)
double precision :: hij
integer :: idx(0:Ndet)
BEGIN_DOC
! <key|H|psi> for the various Nstates
END_DOC
ASSERT (Nint > 0)
ASSERT (N_int == Nint)
ASSERT (Nstate > 0)
ASSERT (Ndet > 0)
ASSERT (Ndet_max >= Ndet)
i_H_psi_array = 0.d0
call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
do ii=1,idx(0)
i = idx(ii)
!DEC$ FORCEINLINE
call i_H_j(keys(1,1,i),key,Nint,hij)
do j = 1, Nstate
i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
enddo
enddo
end
subroutine i_H_psi(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) subroutine i_H_psi(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
use bitmasks use bitmasks
implicit none implicit none