LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00
Code Issues Releases Wiki Activity

Debugged Davidson for large Ndet

Browse Source
This commit is contained in:
Anthony Scemama 2017-04-16 02:37:33 +02:00
parent 9d3d843bc7
commit 957fa694e2
1 changed files with 8 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Davidson/u0Hu0.irp.f
View File

@ -757,23 +757,16 @@ subroutine H_S2_u_0_nstates_bilinear_order(v_0,s_0,u_0,N_st,sze_8)
l_a = psi_bilinear_matrix_columns_loc(lcol) l_a = psi_bilinear_matrix_columns_loc(lcol)
n_doubles=1
! Loop over alpha singles ! Loop over alpha singles
! ----------------------- ! -----------------------
do while ( l_a < psi_bilinear_matrix_columns_loc(lcol+1) ) do while ( l_a < psi_bilinear_matrix_columns_loc(lcol+1) )
lrow = psi_bilinear_matrix_rows(l_a) do l=l_a,psi_bilinear_matrix_columns_loc(lcol+1)
if (.not.is_single_a(lrow)) then lrow = psi_bilinear_matrix_rows(l)
continue if (is_single_a(lrow)) exit
else enddo
doubles(n_doubles) = lrow if (l >= psi_bilinear_matrix_columns_loc(lcol+1)) exit
idx(n_doubles) = l_a l_a = l
if (n_doubles == maxab) then
do k=1,n_doubles
lrow = doubles(k)
l_a = idx(k)
tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, lrow) tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, lrow)
call i_H_j_double_alpha_beta(tmp_det,tmp_det2,N_int,hij) call i_H_j_double_alpha_beta(tmp_det,tmp_det2,N_int,hij)
call get_s2(tmp_det,tmp_det2,N_int,sij) call get_s2(tmp_det,tmp_det2,N_int,sij)
@ -783,30 +776,8 @@ subroutine H_S2_u_0_nstates_bilinear_order(v_0,s_0,u_0,N_st,sze_8)
s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,l_a) s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,l_a)
s_t(l,l_a) = s_t(l,l_a) + sij * u_t(l,k_a) s_t(l,l_a) = s_t(l,l_a) + sij * u_t(l,k_a)
enddo enddo
enddo
n_doubles=0
endif
n_doubles = n_doubles+1
endif
l_a = l_a+1 l_a = l_a+1
enddo enddo
n_doubles = n_doubles-1
do k=1,n_doubles
lrow = doubles(k)
l_a = idx(k)
tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, lrow)
call i_H_j_double_alpha_beta(tmp_det,tmp_det2,N_int,hij)
call get_s2(tmp_det,tmp_det2,N_int,sij)
do l=1,N_st
v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,l_a)
s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,l_a)
v_t(l,l_a) = v_t(l,l_a) + hij * u_t(l,k_a)
s_t(l,l_a) = s_t(l,l_a) + sij * u_t(l,k_a)
enddo
enddo
enddo enddo
enddo enddo