mirror of
https://github.com/LCPQ/quantum_package
synced 2025-01-10 21:18:29 +01:00
Same spin OK
This commit is contained in:
parent
f5903b960c
commit
7c8506386f
@ -613,7 +613,7 @@ end
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
subroutine H_S2_u_0_nstates_new(v_0,s_0,N_st,sze_8)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -627,7 +627,6 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: N_st,sze_8
|
integer, intent(in) :: N_st,sze_8
|
||||||
double precision, intent(out) :: v_0(sze_8,N_st), s_0(sze_8,N_st)
|
double precision, intent(out) :: v_0(sze_8,N_st), s_0(sze_8,N_st)
|
||||||
double precision, intent(in) :: H_jj(*), S2_jj(*)
|
|
||||||
|
|
||||||
|
|
||||||
PROVIDE ref_bitmask_energy
|
PROVIDE ref_bitmask_energy
|
||||||
@ -655,6 +654,8 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
is_single_a(N_det_alpha_unique), &
|
is_single_a(N_det_alpha_unique), &
|
||||||
idx(N_det_alpha_unique), idx0(N_det_alpha_unique) )
|
idx(N_det_alpha_unique), idx0(N_det_alpha_unique) )
|
||||||
|
|
||||||
|
v_0 = 0.d0
|
||||||
|
|
||||||
do k_a=1,N_det-1
|
do k_a=1,N_det-1
|
||||||
|
|
||||||
! Initial determinant is at k_a in alpha-major representation
|
! Initial determinant is at k_a in alpha-major representation
|
||||||
@ -671,22 +672,31 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
|
|
||||||
k_b = psi_bilinear_matrix_order_reverse(k_a)
|
k_b = psi_bilinear_matrix_order_reverse(k_a)
|
||||||
|
|
||||||
|
! Diagonal contribution
|
||||||
|
! ---------------------
|
||||||
|
|
||||||
|
double precision, external :: diag_H_mat_elem
|
||||||
|
|
||||||
|
v_0(k_a,1:N_st) = v_0(k_a,1:N_st) + diag_H_mat_elem(tmp_det,N_int) * &
|
||||||
|
psi_bilinear_matrix_values(k_a,1:N_st)
|
||||||
|
|
||||||
|
|
||||||
! Get all single and double alpha excitations
|
! Get all single and double alpha excitations
|
||||||
! ===========================================
|
! ===========================================
|
||||||
|
|
||||||
l_a = k_a+1
|
|
||||||
spindet(1:N_int) = tmp_det(1:N_int,1)
|
spindet(1:N_int) = tmp_det(1:N_int,1)
|
||||||
|
|
||||||
! Loop inside the beta column to gather all the connected alphas
|
! Loop inside the beta column to gather all the connected alphas
|
||||||
i=1
|
i=1
|
||||||
lcol = kcol
|
l_a = k_a+1
|
||||||
|
lcol = psi_bilinear_matrix_columns(l_a)
|
||||||
do while ( (lcol == kcol).and.(l_a <= N_det) )
|
do while ( (lcol == kcol).and.(l_a <= N_det) )
|
||||||
lrow = psi_bilinear_matrix_rows(l_a)
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
lcol = psi_bilinear_matrix_columns(l_a)
|
|
||||||
buffer(1:N_int,i) = psi_det_alpha_unique(1:N_int, lrow)
|
buffer(1:N_int,i) = psi_det_alpha_unique(1:N_int, lrow)
|
||||||
idx(i) = lrow
|
idx(i) = lrow
|
||||||
i=i+1
|
i=i+1
|
||||||
l_a = l_a + 1
|
l_a = l_a + 1
|
||||||
|
lcol = psi_bilinear_matrix_columns(l_a)
|
||||||
enddo
|
enddo
|
||||||
i = i-1
|
i = i-1
|
||||||
|
|
||||||
@ -697,30 +707,31 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
! Compute Hij for all alpha singles
|
! Compute Hij for all alpha singles
|
||||||
! ----------------------------------
|
! ----------------------------------
|
||||||
|
|
||||||
l_a = k_a+1
|
l_a = k_a
|
||||||
lrow = psi_bilinear_matrix_rows(l_a)
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
tmp_det2(1:N_int,2) = psi_det_beta_unique (1:N_int, kcol)
|
||||||
do i=1,n_singles
|
do i=1,n_singles
|
||||||
call i_H_j_mono_spin( tmp_det(1,1), psi_det_alpha_unique(1, singles(i)), N_int, 1, hij)
|
|
||||||
do while ( lrow < singles(i) )
|
do while ( lrow < singles(i) )
|
||||||
l_a = l_a+1
|
l_a = l_a+1
|
||||||
lrow = psi_bilinear_matrix_rows(l_a)
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
enddo
|
enddo
|
||||||
|
tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, lrow)
|
||||||
|
call i_H_j_mono_spin( tmp_det, tmp_det2, N_int, 1, hij)
|
||||||
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
||||||
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
! Compute Hij for all alpha doubles
|
! Compute Hij for all alpha doubles
|
||||||
! ----------------------------------
|
! ----------------------------------
|
||||||
|
|
||||||
l_a = k_a+1
|
l_a = k_a
|
||||||
lrow = psi_bilinear_matrix_rows(l_a)
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
do i=1,n_doubles
|
do i=1,n_doubles
|
||||||
call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, doubles(i)), N_int, hij)
|
|
||||||
do while (lrow < doubles(i))
|
do while (lrow < doubles(i))
|
||||||
l_a = l_a+1
|
l_a = l_a+1
|
||||||
lrow = psi_bilinear_matrix_rows(l_a)
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
enddo
|
enddo
|
||||||
|
call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, doubles(i)), N_int, hij)
|
||||||
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
||||||
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
||||||
enddo
|
enddo
|
||||||
@ -730,19 +741,19 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
! Get all single and double beta excitations
|
! Get all single and double beta excitations
|
||||||
! ===========================================
|
! ===========================================
|
||||||
|
|
||||||
l_b = k_b+1
|
|
||||||
spindet(1:N_int) = tmp_det(1:N_int,2)
|
spindet(1:N_int) = tmp_det(1:N_int,2)
|
||||||
|
|
||||||
! Loop inside the alpha row to gather all the connected betas
|
! Loop inside the alpha row to gather all the connected betas
|
||||||
i=1
|
i=1
|
||||||
lrow=krow
|
l_b = k_b+1
|
||||||
do while ( (lrow == krow).and.(l_b <= N_det) )
|
|
||||||
lrow = psi_bilinear_matrix_transp_rows(l_b)
|
lrow = psi_bilinear_matrix_transp_rows(l_b)
|
||||||
|
do while ( (lrow == krow).and.(l_b <= N_det) )
|
||||||
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
buffer(1:N_int,i) = psi_det_beta_unique(1:N_int, lcol)
|
buffer(1:N_int,i) = psi_det_beta_unique(1:N_int, lcol)
|
||||||
idx(i) = lcol
|
idx(i) = lcol
|
||||||
i=i+1
|
i=i+1
|
||||||
l_b = l_b + 1
|
l_b = l_b + 1
|
||||||
|
lrow = psi_bilinear_matrix_transp_rows(l_b)
|
||||||
enddo
|
enddo
|
||||||
i = i-1
|
i = i-1
|
||||||
|
|
||||||
@ -755,13 +766,15 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
|
|
||||||
l_b = k_b
|
l_b = k_b
|
||||||
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
|
tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, krow)
|
||||||
do i=1,n_singles
|
do i=1,n_singles
|
||||||
call i_H_j_mono_spin( tmp_det(1,2), psi_det_beta_unique(1, singles(i)), N_int, 2, hij)
|
|
||||||
do while ( lcol < singles(i) )
|
do while ( lcol < singles(i) )
|
||||||
l_b = l_b+1
|
l_b = l_b+1
|
||||||
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
enddo
|
enddo
|
||||||
l_a = psi_bilinear_matrix_order_reverse(l_b)
|
tmp_det2(1:N_int,2) = psi_det_beta_unique (1:N_int, lcol)
|
||||||
|
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||||
|
call i_H_j_mono_spin( tmp_det, tmp_det2, N_int, 2, hij)
|
||||||
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
||||||
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
||||||
enddo
|
enddo
|
||||||
@ -772,18 +785,19 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
l_b = k_b
|
l_b = k_b
|
||||||
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
do i=1,n_doubles
|
do i=1,n_doubles
|
||||||
call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, doubles(i)), N_int, hij)
|
|
||||||
do while (lcol < doubles(i))
|
do while (lcol < doubles(i))
|
||||||
l_b = l_b+1
|
l_b = l_b+1
|
||||||
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
enddo
|
enddo
|
||||||
l_a = psi_bilinear_matrix_order_reverse(l_b)
|
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||||
|
call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, doubles(i)), N_int, hij)
|
||||||
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
||||||
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
|
||||||
! Alpha/Beta double excitations
|
! Alpha/Beta double excitations
|
||||||
! =============================
|
! =============================
|
||||||
|
|
||||||
@ -875,8 +889,8 @@ subroutine H_S2_u_0_nstates_new(v_0,s_0,H_jj,S2_jj,N_st,sze_8)
|
|||||||
mcol = psi_bilinear_matrix_transp_columns(m_b)
|
mcol = psi_bilinear_matrix_transp_columns(m_b)
|
||||||
enddo
|
enddo
|
||||||
m_a = psi_bilinear_matrix_order_reverse(m_b)
|
m_a = psi_bilinear_matrix_order_reverse(m_b)
|
||||||
v_0(m_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
! v_0(m_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st)
|
||||||
v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(m_a,1:N_st)
|
! v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(m_a,1:N_st)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
endif
|
endif
|
||||||
@ -923,11 +937,17 @@ subroutine H_S2_u_0_nstates_test(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze
|
|||||||
|
|
||||||
allocate(idx(0:n), vt(N_st,n))
|
allocate(idx(0:n), vt(N_st,n))
|
||||||
Vt = 0.d0
|
Vt = 0.d0
|
||||||
do i=1,n
|
do i=2,n
|
||||||
idx(0) = i
|
idx(0) = i
|
||||||
call filter_connected(keys_tmp,keys_tmp(1,1,i),Nint,i-1,idx)
|
call filter_connected(keys_tmp,keys_tmp(1,1,i),Nint,i-1,idx)
|
||||||
do jj=1,idx(0)
|
do jj=1,idx(0)
|
||||||
j = idx(jj)
|
j = idx(jj)
|
||||||
|
double precision :: phase
|
||||||
|
integer :: degree
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
call get_excitation(keys_tmp(1,1,j),keys_tmp(1,1,i),exc,degree,phase,Nint)
|
||||||
|
if ((degree == 2).and.(exc(0,1,1)==1)) cycle
|
||||||
|
! if (exc(0,1,2) /= 0) cycle
|
||||||
call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij)
|
call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij)
|
||||||
vt (:,i) = vt (:,i) + hij*u_0(j,:)
|
vt (:,i) = vt (:,i) + hij*u_0(j,:)
|
||||||
vt (:,j) = vt (:,j) + hij*u_0(i,:)
|
vt (:,j) = vt (:,j) + hij*u_0(i,:)
|
||||||
|
@ -2563,7 +2563,7 @@ subroutine i_H_j_mono_spin(key_i,key_j,Nint,spin,hij)
|
|||||||
! Returns <i|H|j> where i and j are determinants differing by a single excitation
|
! Returns <i|H|j> where i and j are determinants differing by a single excitation
|
||||||
END_DOC
|
END_DOC
|
||||||
integer, intent(in) :: Nint, spin
|
integer, intent(in) :: Nint, spin
|
||||||
integer(bit_kind), intent(in) :: key_i(Nint), key_j(Nint)
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
double precision, intent(out) :: hij
|
double precision, intent(out) :: hij
|
||||||
|
|
||||||
integer :: exc(0:2,2)
|
integer :: exc(0:2,2)
|
||||||
@ -2571,13 +2571,7 @@ subroutine i_H_j_mono_spin(key_i,key_j,Nint,spin,hij)
|
|||||||
|
|
||||||
PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map
|
PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map
|
||||||
|
|
||||||
call get_mono_excitation_spin(key_i,key_j,exc,phase,Nint)
|
call get_mono_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||||
if (exc(1,1) == 0) then
|
|
||||||
call debug_spindet(key_i, N_int)
|
|
||||||
call debug_spindet(key_j, N_int)
|
|
||||||
print *, exc(0:2,1:2)
|
|
||||||
stop
|
|
||||||
endif
|
|
||||||
call get_mono_excitation_from_fock(key_i,key_j,exc(1,2),exc(1,1),spin,phase,hij)
|
call get_mono_excitation_from_fock(key_i,key_j,exc(1,2),exc(1,1),spin,phase,hij)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -630,9 +630,9 @@ subroutine get_all_spin_singles_and_doubles(buffer, idx, spindet, Nint, size_buf
|
|||||||
case (1)
|
case (1)
|
||||||
call get_all_spin_singles_and_doubles_1(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
call get_all_spin_singles_and_doubles_1(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
return
|
return
|
||||||
case (2)
|
! case (2)
|
||||||
call get_all_spin_singles_and_doubles_2(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
! call get_all_spin_singles_and_doubles_2(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
return
|
! return
|
||||||
case (3)
|
case (3)
|
||||||
call get_all_spin_singles_and_doubles_3(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
call get_all_spin_singles_and_doubles_3(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles)
|
||||||
return
|
return
|
||||||
|
Loading…
Reference in New Issue
Block a user