mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-25 05:31:48 +02:00
not much of improvements ...
This commit is contained in:
parent
713ef176a1
commit
0b6bc9abc1
@ -16,4 +16,11 @@ doc: If true, the CASSCF starts with a CISD wave function
|
|||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: True
|
default: True
|
||||||
|
|
||||||
|
[state_following_casscf]
|
||||||
|
type: logical
|
||||||
|
doc: If |true|, the CASSCF will try to follow the guess CI vector and orbitals
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: False
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -22,7 +22,7 @@ subroutine routine_bis
|
|||||||
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))
|
||||||
|
@ -54,61 +54,72 @@ END_PROVIDER
|
|||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [real*8, SXvector, (nMonoEx+1)]
|
BEGIN_PROVIDER [real*8, energy_improvement]
|
||||||
&BEGIN_PROVIDER [real*8, energy_improvement]
|
implicit none
|
||||||
|
if(state_following_casscf)then
|
||||||
|
energy_improvement = SXeigenval(best_vector_ovrlp_casscf)
|
||||||
|
else
|
||||||
|
energy_improvement = SXeigenval(1)
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, best_vector_ovrlp_casscf ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, best_overlap_casscf ]
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
double precision :: c0
|
||||||
|
best_overlap_casscf = 0.D0
|
||||||
|
best_vector_ovrlp_casscf = -1000
|
||||||
|
do i=1,nMonoEx+1
|
||||||
|
if (SXeigenval(i).lt.0.D0) then
|
||||||
|
if (abs(SXeigenvec(1,i)).gt.best_overlap_casscf) then
|
||||||
|
best_overlap_casscf=abs(SXeigenvec(1,i))
|
||||||
|
best_vector_ovrlp_casscf = i
|
||||||
|
end if
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
if(best_vector_ovrlp_casscf.lt.0)then
|
||||||
|
best_vector_ovrlp_casscf = minloc(SXeigenval,nMonoEx+1)
|
||||||
|
endif
|
||||||
|
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
||||||
|
if (bavard) then
|
||||||
|
write(6,*) ' SXdiag : eigenvalue for best overlap with '
|
||||||
|
write(6,*) ' previous orbitals = ',SXeigenval(best_vector_ovrlp_casscf)
|
||||||
|
write(6,*) ' weight of the 1st element ',c0
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, SXvector, (nMonoEx+1)]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Best eigenvector of the single-excitation matrix
|
! Best eigenvector of the single-excitation matrix
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: ierr,matz,i
|
integer :: i
|
||||||
real*8 :: c0
|
double precision :: c0
|
||||||
|
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
|
||||||
energy_improvement = SXeigenval(1)
|
|
||||||
|
|
||||||
integer :: best_vector
|
|
||||||
real*8 :: best_overlap
|
|
||||||
best_overlap=0.D0
|
|
||||||
best_vector = -1000
|
|
||||||
do i=1,nMonoEx+1
|
do i=1,nMonoEx+1
|
||||||
if (SXeigenval(i).lt.0.D0) then
|
SXvector(i)=SXeigenvec(i,best_vector_ovrlp_casscf)/c0
|
||||||
if (abs(SXeigenvec(1,i)).gt.best_overlap) then
|
|
||||||
best_overlap=abs(SXeigenvec(1,i))
|
|
||||||
best_vector=i
|
|
||||||
end if
|
|
||||||
end if
|
|
||||||
end do
|
end do
|
||||||
if(best_vector.lt.0)then
|
END_PROVIDER
|
||||||
best_vector = minloc(SXeigenval,nMonoEx+1)
|
|
||||||
endif
|
|
||||||
energy_improvement = SXeigenval(best_vector)
|
|
||||||
|
|
||||||
c0=SXeigenvec(1,best_vector)
|
|
||||||
|
|
||||||
if (bavard) then
|
|
||||||
write(6,*) ' SXdiag : eigenvalue for best overlap with '
|
|
||||||
write(6,*) ' previous orbitals = ',SXeigenval(best_vector)
|
|
||||||
write(6,*) ' weight of the 1st element ',c0
|
|
||||||
endif
|
|
||||||
|
|
||||||
do i=1,nMonoEx+1
|
|
||||||
SXvector(i)=SXeigenvec(i,best_vector)/c0
|
|
||||||
end do
|
|
||||||
|
|
||||||
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [real*8, NewOrbs, (ao_num,mo_num) ]
|
BEGIN_PROVIDER [double precision, NewOrbs, (ao_num,mo_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Updated orbitals
|
! Updated orbitals
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,ialph
|
integer :: i,j,ialph
|
||||||
|
|
||||||
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
if(state_following_casscf)then
|
||||||
NatOrbsFCI, size(NatOrbsFCI,1), &
|
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
||||||
Umat, size(Umat,1), 0.d0, &
|
NatOrbsFCI, size(NatOrbsFCI,1), &
|
||||||
NewOrbs, size(NewOrbs,1))
|
Umat, size(Umat,1), 0.d0, &
|
||||||
|
NewOrbs, size(NewOrbs,1))
|
||||||
|
else
|
||||||
|
NewOrbs = superci_natorb
|
||||||
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user