mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-25 13:03:28 +01:00
Optimized 1rdm
This commit is contained in:
parent
a128c20afa
commit
2ef517488c
@ -1,6 +1,6 @@
|
|||||||
! -*- F90 -*-
|
! -*- F90 -*-
|
||||||
BEGIN_PROVIDER [logical, bavard]
|
BEGIN_PROVIDER [logical, bavard]
|
||||||
bavard=.true.
|
bavard=.true.
|
||||||
bavard=.false.
|
! bavard=.false.
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -1,72 +1,19 @@
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
|
|
||||||
BEGIN_PROVIDER [real*8, D0tu, (n_act_orb,n_act_orb) ]
|
BEGIN_PROVIDER [real*8, D0tu, (n_act_orb,n_act_orb) ]
|
||||||
BEGIN_DOC
|
|
||||||
! the first-order density matrix in the basis of the starting MOs
|
|
||||||
! matrices are state averaged
|
|
||||||
!
|
|
||||||
! we use the spin-free generators of mono-excitations
|
|
||||||
! E_pq destroys q and creates p
|
|
||||||
! D_pq = <0|E_pq|0> = D_qp
|
|
||||||
!
|
|
||||||
END_DOC
|
|
||||||
implicit none
|
implicit none
|
||||||
integer :: t,u,v,x,mu,nu,istate,ispin,jspin,ihole,ipart,jhole,jpart
|
BEGIN_DOC
|
||||||
integer :: ierr
|
! the first-order density matrix in the basis of the starting MOs.
|
||||||
integer(bit_kind) :: det_mu(N_int,2)
|
! matrix is state averaged.
|
||||||
integer(bit_kind) :: det_mu_ex(N_int,2)
|
END_DOC
|
||||||
integer(bit_kind) :: det_mu_ex1(N_int,2)
|
integer :: t,u
|
||||||
integer(bit_kind) :: det_mu_ex2(N_int,2)
|
|
||||||
real*8 :: phase1,phase2,term
|
|
||||||
integer :: nu1,nu2
|
|
||||||
integer :: ierr1,ierr2
|
|
||||||
real*8 :: cI_mu(N_states)
|
|
||||||
|
|
||||||
if (bavard) then
|
|
||||||
write(6,*) ' providing density matrix D0'
|
|
||||||
endif
|
|
||||||
|
|
||||||
D0tu = 0.d0
|
|
||||||
|
|
||||||
! first loop: we apply E_tu, once for D_tu, once for -P_tvvu
|
|
||||||
do mu=1,n_det
|
|
||||||
call det_extract(det_mu,mu,N_int)
|
|
||||||
do istate=1,n_states
|
|
||||||
cI_mu(istate)=psi_coef(mu,istate)
|
|
||||||
end do
|
|
||||||
do t=1,n_act_orb
|
|
||||||
ipart=list_act(t)
|
|
||||||
do u=1,n_act_orb
|
do u=1,n_act_orb
|
||||||
ihole=list_act(u)
|
do t=1,n_act_orb
|
||||||
! apply E_tu
|
D0tu(t,u) = one_e_dm_mo_alpha_average( list_act(t), list_act(u) ) + &
|
||||||
call det_copy(det_mu,det_mu_ex1,N_int)
|
one_e_dm_mo_beta_average ( list_act(t), list_act(u) )
|
||||||
call det_copy(det_mu,det_mu_ex2,N_int)
|
enddo
|
||||||
call do_spinfree_mono_excitation(det_mu,det_mu_ex1 &
|
enddo
|
||||||
,det_mu_ex2,nu1,nu2,ihole,ipart,phase1,phase2,ierr1,ierr2)
|
|
||||||
! det_mu_ex1 is in the list
|
|
||||||
if (nu1.ne.-1) then
|
|
||||||
do istate=1,n_states
|
|
||||||
term=cI_mu(istate)*psi_coef(nu1,istate)*phase1
|
|
||||||
D0tu(t,u)+=term
|
|
||||||
end do
|
|
||||||
end if
|
|
||||||
! det_mu_ex2 is in the list
|
|
||||||
if (nu2.ne.-1) then
|
|
||||||
do istate=1,n_states
|
|
||||||
term=cI_mu(istate)*psi_coef(nu2,istate)*phase2
|
|
||||||
D0tu(t,u)+=term
|
|
||||||
end do
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
! we average by just dividing by the number of states
|
|
||||||
do x=1,n_act_orb
|
|
||||||
do v=1,n_act_orb
|
|
||||||
D0tu(v,x)*=1.0D0/dble(N_states)
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -31,6 +31,8 @@ subroutine do_signed_mono_excitation(key1,key2,nu,ihole,ipart, &
|
|||||||
! get the number in the list
|
! get the number in the list
|
||||||
found=.false.
|
found=.false.
|
||||||
nu=0
|
nu=0
|
||||||
|
|
||||||
|
!TODO BOTTLENECK
|
||||||
do while (.not.found)
|
do while (.not.found)
|
||||||
nu+=1
|
nu+=1
|
||||||
if (nu.gt.N_det) then
|
if (nu.gt.N_det) then
|
||||||
@ -50,13 +52,6 @@ subroutine do_signed_mono_excitation(key1,key2,nu,ihole,ipart, &
|
|||||||
end do
|
end do
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
! if (found) then
|
|
||||||
! if (nu.eq.-1) then
|
|
||||||
! write(6,*) ' image not found in the list, thus nu = ',nu
|
|
||||||
! else
|
|
||||||
! write(6,*) ' found in the list as No ',nu,' phase = ',phase
|
|
||||||
! end if
|
|
||||||
! end if
|
|
||||||
end if
|
end if
|
||||||
!
|
!
|
||||||
! we found the new string, the phase, and possibly the number in the list
|
! we found the new string, the phase, and possibly the number in the list
|
||||||
|
Loading…
Reference in New Issue
Block a user