LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

super_ci density matrix seems to work

Browse Source
This commit is contained in:
eginer 2019-10-22 19:39:49 +02:00
parent c518296711
commit ecc9faa0b9
4 changed files with 23 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/casscf/bavard.irp.f
View File

@ -1,6 +1,6 @@
! -*- F90 -*-
BEGIN_PROVIDER [logical, bavard]
! bavard=.true.
bavard=.false.
bavard=.true.
! bavard=.false.
END_PROVIDER

5
src/casscf/get_energy.irp.f
View File

@ -34,6 +34,11 @@ subroutine routine_bis
print*,'n_elec = ',elec_num
print*,'accu_od= ',accu_od
print*,''
accu_d = 0.d0
do i = 1, N_det
accu_d += psi_coef(i,1)**2
enddo
print*,'accu_d = ',accu_d
end
subroutine routine

22
src/casscf/neworbs.irp.f
View File

@ -40,6 +40,18 @@ END_PROVIDER
! Eigenvectors/eigenvalues of the single-excitation matrix
END_DOC
call lapack_diag(SXeigenval,SXeigenvec,SXmatrix,nMonoEx+1,nMonoEx+1)
if (bavard) then
write(6,*) ' SXdiag : lowest 5 eigenvalues '
write(6,*) ' 1 - ',SXeigenval(1),SXeigenvec(1,1)
if(nmonoex.gt.0)then
write(6,*) ' 2 - ',SXeigenval(2),SXeigenvec(1,2)
write(6,*) ' 3 - ',SXeigenval(3),SXeigenvec(1,3)
write(6,*) ' 4 - ',SXeigenval(4),SXeigenvec(1,4)
write(6,*) ' 5 - ',SXeigenval(5),SXeigenvec(1,5)
endif
write(6,*)
write(6,*) ' SXdiag : lowest eigenvalue = ',SXeigenval(1)
endif
END_PROVIDER
BEGIN_PROVIDER [real*8, SXvector, (nMonoEx+1)]
@ -51,16 +63,6 @@ END_PROVIDER
integer :: ierr,matz,i
real*8 :: c0
if (bavard) then
write(6,*) ' SXdiag : lowest 5 eigenvalues '
write(6,*) ' 1 - ',SXeigenval(1),SXeigenvec(1,1)
write(6,*) ' 2 - ',SXeigenval(2),SXeigenvec(1,2)
write(6,*) ' 3 - ',SXeigenval(3),SXeigenvec(1,3)
write(6,*) ' 4 - ',SXeigenval(4),SXeigenvec(1,4)
write(6,*) ' 5 - ',SXeigenval(5),SXeigenvec(1,5)
write(6,*)
write(6,*) ' SXdiag : lowest eigenvalue = ',SXeigenval(1)
endif
energy_improvement = SXeigenval(1)
integer :: best_vector

10
src/casscf/swap_orb.irp.f
View File

@ -25,13 +25,11 @@
do a = 1, n_virt_orb
aorb = list_virt(a)
super_ci_dm(jorb,iorb) += -2.d0 * lowest_super_ci_coef_mo(aorb,iorb) * lowest_super_ci_coef_mo(aorb,jorb) ! second term in B3.a
super_ci_dm(iorb,jorb) += -2.d0 * lowest_super_ci_coef_mo(aorb,iorb) * lowest_super_ci_coef_mo(aorb,jorb) ! second term in B3.a
enddo
do t = 1, n_act_orb
torb = list_act(t)
! thrid term of the B3.a
super_ci_dm(jorb,iorb) += - lowest_super_ci_coef_mo(iorb,torb) * lowest_super_ci_coef_mo(jorb,torb) * (2.d0 - occ_act(t))
super_ci_dm(iorb,jorb) += - lowest_super_ci_coef_mo(iorb,torb) * lowest_super_ci_coef_mo(jorb,torb) * (2.d0 - occ_act(t))
enddo
enddo
enddo
@ -44,7 +42,7 @@
super_ci_dm(iorb,torb) = c0 * lowest_super_ci_coef_mo(torb,iorb) * (2.d0 - occ_act(t))
super_ci_dm(torb,iorb) = c0 * lowest_super_ci_coef_mo(torb,iorb) * (2.d0 - occ_act(t))
do a = 1, n_virt_orb
aorb = list_act(a)
aorb = list_virt(a)
super_ci_dm(iorb,torb) += - lowest_super_ci_coef_mo(aorb,iorb) * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
super_ci_dm(torb,iorb) += - lowest_super_ci_coef_mo(aorb,iorb) * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
enddo
@ -67,7 +65,7 @@
super_ci_dm(torb,torb) = occ_act(t) ! first term of equation B3.d
do x = 1, n_act_orb
xorb = list_act(x)
super_ci_dm(torb,uorb) += - occ_act(x) * occ_act(t)* mat_tmp_dm_super_ci(x,x) ! second term involving the ONE-rdm
super_ci_dm(torb,torb) += - occ_act(x) * occ_act(t)* mat_tmp_dm_super_ci(x,x) ! second term involving the ONE-rdm
enddo
do u = 1, n_act_orb
uorb = list_act(u)
@ -77,7 +75,7 @@
xorb = list_act(x)
do v = 1, n_act_orb
vorb = list_act(v)
super_ci_dm(torb,uorb) += 2.d0 * P0tuvx(v,x,t,u) * mat_tmp_dm_super_ci(v,x) ! second term involving the TWO-rdm
super_ci_dm(torb,uorb) += 2.d0 * P0tuvx_no(v,x,t,u) * mat_tmp_dm_super_ci(v,x) ! second term involving the TWO-rdm
enddo
enddo
@ -143,7 +141,7 @@
do x = 1, n_act_orb
xorb = list_act(x)
do a = 1, n_virt_orb
aorb = list_act(a)
aorb = list_virt(a)
mat_tmp_dm_super_ci(x,v) += lowest_super_ci_coef_mo(aorb,vorb) * lowest_super_ci_coef_mo(aorb,xorb)
enddo
do i = 1, n_core_inact_orb