mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-07 05:53:37 +01:00
working ...
This commit is contained in:
parent
0b6bc9abc1
commit
b7992a11a9
@ -23,4 +23,9 @@ interface: ezfio,provider,ocaml
|
|||||||
default: False
|
default: False
|
||||||
|
|
||||||
|
|
||||||
|
[level_shift_casscf]
|
||||||
|
type: Positive_float
|
||||||
|
doc: Energy shift on the virtual MOs to improve SCF convergence
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: 0.05
|
||||||
|
|
||||||
|
1
src/casscf/MORALITY
Normal file
1
src/casscf/MORALITY
Normal file
@ -0,0 +1 @@
|
|||||||
|
the CASCF can be obtained if a proper guess is given to the WF part
|
@ -6,19 +6,23 @@ program casscf
|
|||||||
no_vvvv_integrals = .True.
|
no_vvvv_integrals = .True.
|
||||||
pt2_max = 0.02
|
pt2_max = 0.02
|
||||||
SOFT_TOUCH no_vvvv_integrals pt2_max
|
SOFT_TOUCH no_vvvv_integrals pt2_max
|
||||||
|
call run_stochastic_cipsi
|
||||||
call run
|
call run
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine run
|
subroutine run
|
||||||
implicit none
|
implicit none
|
||||||
double precision :: energy_old, energy
|
double precision :: energy_old, energy
|
||||||
logical :: converged
|
logical :: converged,state_following_casscf_save
|
||||||
integer :: iteration
|
integer :: iteration
|
||||||
converged = .False.
|
converged = .False.
|
||||||
|
|
||||||
energy = 0.d0
|
energy = 0.d0
|
||||||
mo_label = "MCSCF"
|
mo_label = "MCSCF"
|
||||||
iteration = 1
|
iteration = 1
|
||||||
|
state_following_casscf_save = state_following_casscf
|
||||||
|
state_following_casscf = .True.
|
||||||
|
touch state_following_casscf
|
||||||
do while (.not.converged)
|
do while (.not.converged)
|
||||||
call run_stochastic_cipsi
|
call run_stochastic_cipsi
|
||||||
energy_old = energy
|
energy_old = energy
|
||||||
@ -41,6 +45,10 @@ subroutine run
|
|||||||
read_wf = .True.
|
read_wf = .True.
|
||||||
call clear_mo_map
|
call clear_mo_map
|
||||||
SOFT_TOUCH mo_coef N_det pt2_max psi_det psi_coef
|
SOFT_TOUCH mo_coef N_det pt2_max psi_det psi_coef
|
||||||
|
if(iteration .gt. 3)then
|
||||||
|
state_following_casscf = state_following_casscf_save
|
||||||
|
touch state_following_casscf
|
||||||
|
endif
|
||||||
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
|
@ -16,30 +16,34 @@ subroutine routine_bis
|
|||||||
implicit none
|
implicit none
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
double precision :: accu_d,accu_od
|
double precision :: accu_d,accu_od
|
||||||
accu_d = 0.d0
|
!accu_d = 0.d0
|
||||||
accu_od = 0.d0
|
!accu_od = 0.d0
|
||||||
print*,''
|
!print*,''
|
||||||
print*,''
|
!print*,''
|
||||||
print*,''
|
!print*,''
|
||||||
do i = 1, mo_num
|
!do i = 1, mo_num
|
||||||
! write(*,'(100(F8.5,X))')super_ci_dm(i,:)
|
! write(*,'(100(F8.5,X))')super_ci_dm(i,:)
|
||||||
accu_d += super_ci_dm(i,i)
|
! accu_d += super_ci_dm(i,i)
|
||||||
do j = i+1, mo_num
|
! do j = i+1, mo_num
|
||||||
accu_od += dabs(super_ci_dm(i,j) - super_ci_dm(j,i))
|
! accu_od += dabs(super_ci_dm(i,j) - super_ci_dm(j,i))
|
||||||
enddo
|
! enddo
|
||||||
enddo
|
!enddo
|
||||||
print*,''
|
!print*,''
|
||||||
print*,''
|
!print*,''
|
||||||
print*,'accu_d = ',accu_d
|
!print*,'accu_d = ',accu_d
|
||||||
print*,'n_elec = ',elec_num
|
!print*,'n_elec = ',elec_num
|
||||||
print*,'accu_od= ',accu_od
|
!print*,'accu_od= ',accu_od
|
||||||
print*,''
|
!print*,''
|
||||||
accu_d = 0.d0
|
!accu_d = 0.d0
|
||||||
do i = 1, N_det
|
!do i = 1, N_det
|
||||||
accu_d += psi_coef(i,1)**2
|
! accu_d += psi_coef(i,1)**2
|
||||||
enddo
|
!enddo
|
||||||
print*,'accu_d = ',accu_d
|
!print*,'accu_d = ',accu_d
|
||||||
provide superci_natorb
|
!provide superci_natorb
|
||||||
|
|
||||||
|
provide switch_mo_coef
|
||||||
|
mo_coef = switch_mo_coef
|
||||||
|
call save_mos
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine routine
|
subroutine routine
|
||||||
|
@ -24,6 +24,9 @@ BEGIN_PROVIDER [real*8, SXmatrix, (nMonoEx+1,nMonoEx+1)]
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
do i = 1, nMonoEx
|
||||||
|
SXmatrix(i+1,i+1) += level_shift_casscf
|
||||||
|
enddo
|
||||||
if (bavard) then
|
if (bavard) then
|
||||||
do i=2,nMonoEx
|
do i=2,nMonoEx
|
||||||
write(6,*) ' diagonal of the Hessian : ',i,hessmat2(i,i)
|
write(6,*) ' diagonal of the Hessian : ',i,hessmat2(i,i)
|
||||||
@ -86,7 +89,7 @@ END_PROVIDER
|
|||||||
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
||||||
if (bavard) then
|
if (bavard) then
|
||||||
write(6,*) ' SXdiag : eigenvalue for best overlap with '
|
write(6,*) ' SXdiag : eigenvalue for best overlap with '
|
||||||
write(6,*) ' previous orbitals = ',SXeigenval(best_vector_ovrlp_casscf)
|
write(6,*) ' previous orbitals = ',SXeigenval(best_vector_ovrlp_casscf)
|
||||||
write(6,*) ' weight of the 1st element ',c0
|
write(6,*) ' weight of the 1st element ',c0
|
||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
@ -99,8 +102,10 @@ END_PROVIDER
|
|||||||
integer :: i
|
integer :: i
|
||||||
double precision :: c0
|
double precision :: c0
|
||||||
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
||||||
|
print*,'c0 = ',c0
|
||||||
do i=1,nMonoEx+1
|
do i=1,nMonoEx+1
|
||||||
SXvector(i)=SXeigenvec(i,best_vector_ovrlp_casscf)/c0
|
SXvector(i)=SXeigenvec(i,best_vector_ovrlp_casscf)/c0
|
||||||
|
print*,'',i,SXvector(i)
|
||||||
end do
|
end do
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
@ -113,12 +118,31 @@ BEGIN_PROVIDER [double precision, NewOrbs, (ao_num,mo_num) ]
|
|||||||
integer :: i,j,ialph
|
integer :: i,j,ialph
|
||||||
|
|
||||||
if(state_following_casscf)then
|
if(state_following_casscf)then
|
||||||
|
print*,'Using the state following casscf '
|
||||||
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
||||||
NatOrbsFCI, size(NatOrbsFCI,1), &
|
NatOrbsFCI, size(NatOrbsFCI,1), &
|
||||||
Umat, size(Umat,1), 0.d0, &
|
Umat, size(Umat,1), 0.d0, &
|
||||||
NewOrbs, size(NewOrbs,1))
|
NewOrbs, size(NewOrbs,1))
|
||||||
else
|
else
|
||||||
NewOrbs = superci_natorb
|
double precision :: damp
|
||||||
|
print*,'Taking the lowest root for the CASSCF'
|
||||||
|
if(best_vector_ovrlp_casscf.ne.1)then
|
||||||
|
provide n_orb_swap
|
||||||
|
!call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
||||||
|
! NatOrbsFCI, size(NatOrbsFCI,1), &
|
||||||
|
! Umat, size(Umat,1), 0.d0, &
|
||||||
|
! NewOrbs, size(NewOrbs,1))
|
||||||
|
NewOrbs = switch_mo_coef
|
||||||
|
mo_coef = switch_mo_coef
|
||||||
|
soft_touch mo_coef
|
||||||
|
call save_mos_no_occ
|
||||||
|
stop
|
||||||
|
else
|
||||||
|
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
||||||
|
NatOrbsFCI, size(NatOrbsFCI,1), &
|
||||||
|
Umat, size(Umat,1), 0.d0, &
|
||||||
|
NewOrbs, size(NewOrbs,1))
|
||||||
|
endif
|
||||||
endif
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
207
src/casscf/superci_dm.irp.f
Normal file
207
src/casscf/superci_dm.irp.f
Normal file
@ -0,0 +1,207 @@
|
|||||||
|
BEGIN_PROVIDER [double precision, super_ci_dm, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! density matrix of the super CI matrix, in the basis of NATURAL ORBITALS OF THE CASCI WF
|
||||||
|
!
|
||||||
|
! This is obtained from annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
!
|
||||||
|
! WARNING ::: in the equation B3.d there is a TYPO with a forgotten MINUS SIGN (see variable mat_tmp_dm_super_ci )
|
||||||
|
END_DOC
|
||||||
|
super_ci_dm = 0.d0
|
||||||
|
integer :: i,j,iorb,jorb
|
||||||
|
integer :: a,aorb,b,borb
|
||||||
|
integer :: t,torb,v,vorb,u,uorb,x,xorb
|
||||||
|
double precision :: c0,ci
|
||||||
|
c0 = SXeigenvec(1,1)
|
||||||
|
! equation B3.a of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
! loop over the core/inact
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
super_ci_dm(iorb,iorb) = 2.d0 ! first term of B3.a
|
||||||
|
! loop over the core/inact
|
||||||
|
do j = 1, n_core_inact_orb
|
||||||
|
jorb = list_core_inact(j)
|
||||||
|
! loop over the virtual
|
||||||
|
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
|
||||||
|
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))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! equation B3.b of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
do t = 1, n_act_orb
|
||||||
|
torb = list_act(t)
|
||||||
|
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_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
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! equation B3.c of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
do a = 1, n_virt_orb
|
||||||
|
aorb = list_virt(a)
|
||||||
|
super_ci_dm(aorb,iorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
||||||
|
super_ci_dm(iorb,aorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! equation B3.d of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do t = 1, n_act_orb
|
||||||
|
torb = list_act(t)
|
||||||
|
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,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)
|
||||||
|
|
||||||
|
! second term of equation B3.d
|
||||||
|
do x = 1, n_act_orb
|
||||||
|
xorb = list_act(x)
|
||||||
|
do v = 1, n_act_orb
|
||||||
|
vorb = list_act(v)
|
||||||
|
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
|
||||||
|
|
||||||
|
! third term of equation B3.d
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
super_ci_dm(torb,uorb) += lowest_super_ci_coef_mo(iorb,torb) * lowest_super_ci_coef_mo(iorb,uorb) * (2.d0 - occ_act(t) - occ_act(u))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! equation B3.e of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do t = 1, n_act_orb
|
||||||
|
torb = list_act(t)
|
||||||
|
do a = 1, n_virt_orb
|
||||||
|
aorb = list_virt(a)
|
||||||
|
super_ci_dm(aorb,torb) += c0 * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
||||||
|
super_ci_dm(torb,aorb) += c0 * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
super_ci_dm(aorb,torb) += lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,torb) * (2.d0 - occ_act(t))
|
||||||
|
super_ci_dm(torb,aorb) += lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,torb) * (2.d0 - occ_act(t))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! equation B3.f of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do a = 1, n_virt_orb
|
||||||
|
aorb = list_virt(a)
|
||||||
|
do b = 1, n_virt_orb
|
||||||
|
borb= list_virt(b)
|
||||||
|
|
||||||
|
! First term of equation B3.f
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
super_ci_dm(borb,aorb) += 2.d0 * lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,borb)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Second term of equation B3.f
|
||||||
|
do t = 1, n_act_orb
|
||||||
|
torb = list_act(t)
|
||||||
|
super_ci_dm(borb,aorb) += lowest_super_ci_coef_mo(torb,aorb) * lowest_super_ci_coef_mo(torb,borb) * occ_act(t)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, superci_natorb, (ao_num,mo_num)
|
||||||
|
&BEGIN_PROVIDER [double precision, superci_nat_occ, (mo_num)
|
||||||
|
implicit none
|
||||||
|
call general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(super_ci_dm,mo_num,mo_num,mo_num,NatOrbsFCI,superci_nat_occ,superci_natorb)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, mat_tmp_dm_super_ci, (n_act_orb,n_act_orb)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! computation of the term in [ ] in the equation B3.d of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
!
|
||||||
|
! !!!!! WARNING !!!!!! there is a TYPO: a MINUS SIGN SHOULD APPEAR in that term
|
||||||
|
END_DOC
|
||||||
|
integer :: a,aorb,i,iorb
|
||||||
|
integer :: x,xorb,v,vorb
|
||||||
|
mat_tmp_dm_super_ci = 0.d0
|
||||||
|
do v = 1, n_act_orb
|
||||||
|
vorb = list_act(v)
|
||||||
|
do x = 1, n_act_orb
|
||||||
|
xorb = list_act(x)
|
||||||
|
do a = 1, n_virt_orb
|
||||||
|
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
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
! MARK THE MINUS SIGN HERE !!!!!!!!!!! BECAUSE OF TYPO IN THE ORIGINAL PAPER
|
||||||
|
mat_tmp_dm_super_ci(x,v) -= lowest_super_ci_coef_mo(iorb,vorb) * lowest_super_ci_coef_mo(iorb,xorb)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, lowest_super_ci_coef_mo, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,iorb,jorb
|
||||||
|
integer :: a, aorb,t, torb
|
||||||
|
double precision :: sqrt2
|
||||||
|
|
||||||
|
sqrt2 = 1.d0/dsqrt(2.d0)
|
||||||
|
do i = 1, nMonoEx
|
||||||
|
iorb = excit(1,i)
|
||||||
|
jorb = excit(2,i)
|
||||||
|
lowest_super_ci_coef_mo(iorb,jorb) = SXeigenvec(i+1,1)
|
||||||
|
lowest_super_ci_coef_mo(jorb,iorb) = SXeigenvec(i+1,1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! a_{it} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
do t = 1, n_act_orb
|
||||||
|
torb = list_act(t)
|
||||||
|
lowest_super_ci_coef_mo(torb,iorb) *= (2.d0 - occ_act(t))**(-0.5d0)
|
||||||
|
lowest_super_ci_coef_mo(iorb,torb) *= (2.d0 - occ_act(t))**(-0.5d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! a_{ia} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do i = 1, n_core_inact_orb
|
||||||
|
iorb = list_core_inact(i)
|
||||||
|
do a = 1, n_virt_orb
|
||||||
|
aorb = list_virt(a)
|
||||||
|
lowest_super_ci_coef_mo(aorb,iorb) *= sqrt2
|
||||||
|
lowest_super_ci_coef_mo(iorb,aorb) *= sqrt2
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! a_{ta} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
||||||
|
do a = 1, n_virt_orb
|
||||||
|
aorb = list_virt(a)
|
||||||
|
do t = 1, n_act_orb
|
||||||
|
torb = list_act(t)
|
||||||
|
lowest_super_ci_coef_mo(torb,aorb) *= occ_act(t)**(-0.5d0)
|
||||||
|
lowest_super_ci_coef_mo(aorb,torb) *= occ_act(t)**(-0.5d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -1,207 +1,122 @@
|
|||||||
BEGIN_PROVIDER [double precision, super_ci_dm, (mo_num,mo_num)]
|
BEGIN_PROVIDER [double precision, SXvector_lowest, (nMonoEx)]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
integer :: i
|
||||||
! density matrix of the super CI matrix, in the basis of NATURAL ORBITALS OF THE CASCI WF
|
do i=2,nMonoEx+1
|
||||||
!
|
SXvector_lowest(i-1)=SXeigenvec(i,1)
|
||||||
! This is obtained from annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
!
|
|
||||||
! WARNING ::: in the equation B3.d there is a TYPO with a forgotten MINUS SIGN (see variable mat_tmp_dm_super_ci )
|
|
||||||
END_DOC
|
|
||||||
super_ci_dm = 0.d0
|
|
||||||
integer :: i,j,iorb,jorb
|
|
||||||
integer :: a,aorb,b,borb
|
|
||||||
integer :: t,torb,v,vorb,u,uorb,x,xorb
|
|
||||||
double precision :: c0,ci
|
|
||||||
c0 = SXeigenvec(1,1)
|
|
||||||
! equation B3.a of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
! loop over the core/inact
|
|
||||||
do i = 1, n_core_inact_orb
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
super_ci_dm(iorb,iorb) = 2.d0 ! first term of B3.a
|
|
||||||
! loop over the core/inact
|
|
||||||
do j = 1, n_core_inact_orb
|
|
||||||
jorb = list_core_inact(j)
|
|
||||||
! loop over the virtual
|
|
||||||
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
|
|
||||||
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))
|
|
||||||
enddo
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
|
||||||
|
|
||||||
! equation B3.b of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
do i = 1, n_core_inact_orb
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
do t = 1, n_act_orb
|
|
||||||
torb = list_act(t)
|
|
||||||
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_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
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! equation B3.c of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
do i = 1, n_core_inact_orb
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
do a = 1, n_virt_orb
|
|
||||||
aorb = list_virt(a)
|
|
||||||
super_ci_dm(aorb,iorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
|
||||||
super_ci_dm(iorb,aorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! equation B3.d of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
do t = 1, n_act_orb
|
|
||||||
torb = list_act(t)
|
|
||||||
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,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)
|
|
||||||
|
|
||||||
! second term of equation B3.d
|
|
||||||
do x = 1, n_act_orb
|
|
||||||
xorb = list_act(x)
|
|
||||||
do v = 1, n_act_orb
|
|
||||||
vorb = list_act(v)
|
|
||||||
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
|
|
||||||
|
|
||||||
! third term of equation B3.d
|
|
||||||
do i = 1, n_core_inact_orb
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
super_ci_dm(torb,uorb) += lowest_super_ci_coef_mo(iorb,torb) * lowest_super_ci_coef_mo(iorb,uorb) * (2.d0 - occ_act(t) - occ_act(u))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! equation B3.e of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
do t = 1, n_act_orb
|
|
||||||
torb = list_act(t)
|
|
||||||
do a = 1, n_virt_orb
|
|
||||||
aorb = list_virt(a)
|
|
||||||
super_ci_dm(aorb,torb) += c0 * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
|
||||||
super_ci_dm(torb,aorb) += c0 * lowest_super_ci_coef_mo(aorb,torb) * occ_act(t)
|
|
||||||
do i = 1, n_core_inact_orb
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
super_ci_dm(aorb,torb) += lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,torb) * (2.d0 - occ_act(t))
|
|
||||||
super_ci_dm(torb,aorb) += lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,torb) * (2.d0 - occ_act(t))
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! equation B3.f of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
do a = 1, n_virt_orb
|
|
||||||
aorb = list_virt(a)
|
|
||||||
do b = 1, n_virt_orb
|
|
||||||
borb= list_virt(b)
|
|
||||||
|
|
||||||
! First term of equation B3.f
|
|
||||||
do i = 1, n_core_inact_orb
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
super_ci_dm(borb,aorb) += 2.d0 * lowest_super_ci_coef_mo(iorb,aorb) * lowest_super_ci_coef_mo(iorb,borb)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! Second term of equation B3.f
|
|
||||||
do t = 1, n_act_orb
|
|
||||||
torb = list_act(t)
|
|
||||||
super_ci_dm(borb,aorb) += lowest_super_ci_coef_mo(torb,aorb) * lowest_super_ci_coef_mo(torb,borb) * occ_act(t)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, superci_natorb, (ao_num,mo_num)
|
BEGIN_PROVIDER [double precision, thresh_overlap_switch]
|
||||||
&BEGIN_PROVIDER [double precision, superci_nat_occ, (mo_num)
|
|
||||||
implicit none
|
implicit none
|
||||||
call general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(super_ci_dm,mo_num,mo_num,mo_num,superci_nat_occ,superci_natorb)
|
thresh_overlap_switch = 0.5d0
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, mat_tmp_dm_super_ci, (n_act_orb,n_act_orb)]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! computation of the term in [ ] in the equation B3.d of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
!
|
|
||||||
! !!!!! WARNING !!!!!! there is a TYPO: a MINUS SIGN SHOULD APPEAR in that term
|
|
||||||
END_DOC
|
|
||||||
integer :: a,aorb,i,iorb
|
|
||||||
integer :: x,xorb,v,vorb
|
|
||||||
mat_tmp_dm_super_ci = 0.d0
|
|
||||||
do v = 1, n_act_orb
|
|
||||||
vorb = list_act(v)
|
|
||||||
do x = 1, n_act_orb
|
|
||||||
xorb = list_act(x)
|
|
||||||
do a = 1, n_virt_orb
|
|
||||||
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
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
! MARK THE MINUS SIGN HERE !!!!!!!!!!! BECAUSE OF TYPO IN THE ORIGINAL PAPER
|
|
||||||
mat_tmp_dm_super_ci(x,v) -= lowest_super_ci_coef_mo(iorb,vorb) * lowest_super_ci_coef_mo(iorb,xorb)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, lowest_super_ci_coef_mo, (mo_num,mo_num)]
|
BEGIN_PROVIDER [integer, max_overlap, (nMonoEx)]
|
||||||
|
&BEGIN_PROVIDER [integer, n_max_overlap]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,j,iorb,jorb
|
double precision, allocatable :: vec_tmp(:)
|
||||||
integer :: a, aorb,t, torb
|
integer, allocatable :: iorder(:)
|
||||||
double precision :: sqrt2
|
allocate(vec_tmp(nMonoEx),iorder(nMonoEx))
|
||||||
|
integer :: i
|
||||||
sqrt2 = 1.d0/dsqrt(2.d0)
|
|
||||||
do i = 1, nMonoEx
|
do i = 1, nMonoEx
|
||||||
iorb = excit(1,i)
|
iorder(i) = i
|
||||||
jorb = excit(2,i)
|
vec_tmp(i) = -dabs(SXvector_lowest(i))
|
||||||
lowest_super_ci_coef_mo(iorb,jorb) = SXeigenvec(i+1,1)
|
print*,'vec_tmp(i) = ',i,vec_tmp(i)
|
||||||
lowest_super_ci_coef_mo(jorb,iorb) = SXeigenvec(i+1,1)
|
|
||||||
enddo
|
enddo
|
||||||
|
call dsort(vec_tmp,iorder,nMonoEx)
|
||||||
! a_{it} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
n_max_overlap = 0
|
||||||
do i = 1, n_core_inact_orb
|
do i = 1, nMonoEx
|
||||||
iorb = list_core_inact(i)
|
if(dabs(vec_tmp(i)).gt.thresh_overlap_switch)then
|
||||||
do t = 1, n_act_orb
|
print*,vec_tmp(i),iorder(i)
|
||||||
torb = list_act(t)
|
n_max_overlap += 1
|
||||||
lowest_super_ci_coef_mo(torb,iorb) *= (2.d0 - occ_act(t))**(-0.5d0)
|
max_overlap(n_max_overlap) = iorder(i)
|
||||||
lowest_super_ci_coef_mo(iorb,torb) *= (2.d0 - occ_act(t))**(-0.5d0)
|
endif
|
||||||
enddo
|
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
! a_{ia} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
do i = 1, n_core_inact_orb
|
|
||||||
iorb = list_core_inact(i)
|
|
||||||
do a = 1, n_virt_orb
|
|
||||||
aorb = list_virt(a)
|
|
||||||
lowest_super_ci_coef_mo(aorb,iorb) *= sqrt2
|
|
||||||
lowest_super_ci_coef_mo(iorb,aorb) *= sqrt2
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! a_{ta} of the equation B.2 of Roos et. al. Chemical Physics 48 (1980) 157-173
|
|
||||||
do a = 1, n_virt_orb
|
|
||||||
aorb = list_virt(a)
|
|
||||||
do t = 1, n_act_orb
|
|
||||||
torb = list_act(t)
|
|
||||||
lowest_super_ci_coef_mo(torb,aorb) *= occ_act(t)**(-0.5d0)
|
|
||||||
lowest_super_ci_coef_mo(aorb,torb) *= occ_act(t)**(-0.5d0)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, orb_swap, (2,n_max_overlap)]
|
||||||
|
&BEGIN_PROVIDER [integer, n_orb_swap ]
|
||||||
|
implicit none
|
||||||
|
use bitmasks ! you need to include the bitmasks_module.f90 features
|
||||||
|
integer :: i,imono,iorb,jorb,j
|
||||||
|
n_orb_swap = 0
|
||||||
|
do i = 1, n_max_overlap
|
||||||
|
imono = max_overlap(i)
|
||||||
|
iorb = excit(1,imono)
|
||||||
|
jorb = excit(2,imono)
|
||||||
|
if (excit_class(imono) == "c-a")then ! core --> active rotation
|
||||||
|
n_orb_swap += 1
|
||||||
|
orb_swap(1,n_orb_swap) = iorb ! core
|
||||||
|
orb_swap(2,n_orb_swap) = jorb ! active
|
||||||
|
else if (excit_class(imono) == "a-v")then ! active --> virtual rotation
|
||||||
|
n_orb_swap += 1
|
||||||
|
orb_swap(1,n_orb_swap) = jorb ! virtual
|
||||||
|
orb_swap(2,n_orb_swap) = iorb ! active
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print*,'n_orb_swap = ',n_orb_swap
|
||||||
|
do i = 1, n_orb_swap
|
||||||
|
print*,orb_swap(1,i),'-->',orb_swap(2,i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
orb_swap_tmp = orb_swap
|
||||||
|
integer :: orb_swap_tmp(2,n_max_overlap)
|
||||||
|
integer(bit_kind), allocatable :: det_i(:),det_j(:)
|
||||||
|
allocate(det_i(N_int),det_j(N_int))
|
||||||
|
logical, allocatable :: good_orb_rot(:)
|
||||||
|
allocate(good_orb_rot(n_orb_swap))
|
||||||
|
good_orb_rot = .True.
|
||||||
|
integer :: icount,k
|
||||||
|
do i = 1, n_orb_swap
|
||||||
|
if(.not.good_orb_rot(i))cycle
|
||||||
|
det_i = 0_bit_kind
|
||||||
|
call set_bit_to_integer(orb_swap(1,i),det_i,N_int)
|
||||||
|
call set_bit_to_integer(orb_swap(2,i),det_i,N_int)
|
||||||
|
do j = i+1, n_orb_swap
|
||||||
|
det_j = 0_bit_kind
|
||||||
|
call set_bit_to_integer(orb_swap(1,j),det_j,N_int)
|
||||||
|
call set_bit_to_integer(orb_swap(2,j),det_j,N_int)
|
||||||
|
icount = 0
|
||||||
|
do k = 1, N_int
|
||||||
|
icount += popcnt(ior(det_i(k),det_j(k)))
|
||||||
|
enddo
|
||||||
|
if (icount.ne.4)then
|
||||||
|
good_orb_rot(i) = .False.
|
||||||
|
good_orb_rot(j) = .False.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
icount = n_orb_swap
|
||||||
|
n_orb_swap = 0
|
||||||
|
do i = 1, icount
|
||||||
|
if(good_orb_rot(i))then
|
||||||
|
n_orb_swap += 1
|
||||||
|
orb_swap(1,n_orb_swap) = orb_swap_tmp(1,i)
|
||||||
|
orb_swap(2,n_orb_swap) = orb_swap_tmp(2,i)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
print*,'Cleaning !!'
|
||||||
|
print*,'n_orb_swap = ',n_orb_swap
|
||||||
|
do i = 1, n_orb_swap
|
||||||
|
print*,orb_swap(1,i),'-->',orb_swap(2,i)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, switch_mo_coef, (ao_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,iorb,jorb
|
||||||
|
switch_mo_coef = NatOrbsFCI
|
||||||
|
do i = 1, n_orb_swap
|
||||||
|
iorb = orb_swap(1,i)
|
||||||
|
jorb = orb_swap(2,i)
|
||||||
|
do j = 1, ao_num
|
||||||
|
switch_mo_coef(j,jorb) = NatOrbsFCI(j,iorb)
|
||||||
|
enddo
|
||||||
|
do j = 1, ao_num
|
||||||
|
switch_mo_coef(j,iorb) = NatOrbsFCI(j,jorb)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
@ -4,7 +4,7 @@ subroutine save_mos
|
|||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
|
||||||
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
||||||
|
print*,'Saving MOs'
|
||||||
call ezfio_set_mo_basis_mo_num(mo_num)
|
call ezfio_set_mo_basis_mo_num(mo_num)
|
||||||
call ezfio_set_mo_basis_mo_label(mo_label)
|
call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
||||||
@ -18,6 +18,31 @@ subroutine save_mos
|
|||||||
call ezfio_set_mo_basis_mo_coef(buffer)
|
call ezfio_set_mo_basis_mo_coef(buffer)
|
||||||
call ezfio_set_mo_basis_mo_occ(mo_occ)
|
call ezfio_set_mo_basis_mo_occ(mo_occ)
|
||||||
deallocate (buffer)
|
deallocate (buffer)
|
||||||
|
print*,'End Saving MOs'
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine save_mos_no_occ
|
||||||
|
implicit none
|
||||||
|
double precision, allocatable :: buffer(:,:)
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
||||||
|
print*,'Saving MOs'
|
||||||
|
!call ezfio_set_mo_basis_mo_num(mo_num)
|
||||||
|
!call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
|
!call ezfio_set_mo_basis_ao_md5(ao_md5)
|
||||||
|
allocate ( buffer(ao_num,mo_num) )
|
||||||
|
buffer = 0.d0
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
buffer(i,j) = mo_coef(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call ezfio_set_mo_basis_mo_coef(buffer)
|
||||||
|
deallocate (buffer)
|
||||||
|
print*,'End Saving MOs'
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -217,10 +242,10 @@ subroutine mo_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,eig,label)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,eig,mo_coef_new)
|
subroutine general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,mo_coef_before,eig,mo_coef_new)
|
||||||
implicit none
|
implicit none
|
||||||
integer,intent(in) :: lda,m,n
|
integer,intent(in) :: lda,m,n
|
||||||
double precision, intent(in) :: matrix(lda,n)
|
double precision, intent(in) :: matrix(lda,n),mo_coef_before(ao_num,m)
|
||||||
double precision, intent(out) :: eig(m),mo_coef_new(ao_num,m)
|
double precision, intent(out) :: eig(m),mo_coef_new(ao_num,m)
|
||||||
|
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
@ -241,7 +266,7 @@ subroutine general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,ei
|
|||||||
A(i,j) = matrix(i,j)
|
A(i,j) = matrix(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
mo_coef_tmp = mo_coef
|
mo_coef_tmp = mo_coef_before
|
||||||
|
|
||||||
call svd(A,lda,U,lda,D,Vt,lda,m,n)
|
call svd(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
@ -261,7 +286,7 @@ subroutine general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,ei
|
|||||||
write (6,'(A)') '======== ================ ================'
|
write (6,'(A)') '======== ================ ================'
|
||||||
write (6,'(A)') ''
|
write (6,'(A)') ''
|
||||||
|
|
||||||
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef_new,size(mo_coef,1))
|
call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef_new,size(mo_coef_new,1))
|
||||||
|
|
||||||
do i=1,m
|
do i=1,m
|
||||||
eig(i) = D(i)
|
eig(i) = D(i)
|
||||||
|
Loading…
Reference in New Issue
Block a user