mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-24 21:41:46 +02:00
Minor changes
This commit is contained in:
parent
cde801f276
commit
cc66ed86db
@ -385,31 +385,12 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s
|
||||
! -----------------------------------------
|
||||
|
||||
do k=1,N_st_diag
|
||||
! if (state_ok(k)) then
|
||||
do i=1,sze
|
||||
U(i,shift2+k) = &
|
||||
(lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) &
|
||||
* (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz &
|
||||
)/max(H_jj(i) - lambda (k),1.d-2)
|
||||
enddo
|
||||
! else
|
||||
! ! Randomize components with bad <S2>
|
||||
! do i=1,sze-2,2
|
||||
! call random_number(r1)
|
||||
! call random_number(r2)
|
||||
! r1 = dsqrt(-2.d0*dlog(r1))
|
||||
! r2 = dtwo_pi*r2
|
||||
! U(i,shift2+k) = r1*dcos(r2)
|
||||
! U(i+1,shift2+k) = r1*dsin(r2)
|
||||
! enddo
|
||||
! do i=sze-2+1,sze
|
||||
! call random_number(r1)
|
||||
! call random_number(r2)
|
||||
! r1 = dsqrt(-2.d0*dlog(r1))
|
||||
! r2 = dtwo_pi*r2
|
||||
! U(i,shift2+k) = r1*dcos(r2)
|
||||
! enddo
|
||||
! endif
|
||||
do i=1,sze
|
||||
U(i,shift2+k) = &
|
||||
(lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) &
|
||||
* (1.d0 + s2(k) * U(i,shift2+k) - S(i,shift2+k) - S_z2_Sz &
|
||||
)/max(H_jj(i) - lambda (k),1.d-2)
|
||||
enddo
|
||||
|
||||
if (k <= N_st) then
|
||||
residual_norm(k) = u_dot_u(U(1,shift2+k),sze)
|
||||
|
@ -313,7 +313,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
|
||||
integer :: blockb, blockb2, istep
|
||||
double precision :: ave_workload, workload, target_workload_inv
|
||||
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: vt, ut
|
||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: vt, ut, st
|
||||
|
||||
N_st_8 = align_double(N_st)
|
||||
|
||||
@ -353,6 +353,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
|
||||
ext = 0
|
||||
do ni=1,Nint
|
||||
ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2)))
|
||||
if (ext > 4) exit
|
||||
end do
|
||||
if(ext == 4) then
|
||||
call i_h_j (keys_tmp(1,1,org_j),keys_tmp(1,1,org_i),nint,hij)
|
||||
@ -394,6 +395,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8)
|
||||
ext = exa
|
||||
do ni=1,Nint
|
||||
ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1)))
|
||||
if (ext > 4) exit
|
||||
end do
|
||||
if(ext <= 4) then
|
||||
org_j = sort_idx(j,1)
|
||||
|
Loading…
Reference in New Issue
Block a user