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

not much of improvements ...

Browse Source
This commit is contained in:
eginer 2019-10-22 20:22:54 +02:00
parent 713ef176a1
commit 0b6bc9abc1
4 changed files with 62 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/casscf/EZFIO.cfg
View File

@ -16,4 +16,11 @@ doc: If true, the CASSCF starts with a CISD wave function
interface: ezfio,provider,ocaml
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

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

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

@ -22,7 +22,7 @@ subroutine routine_bis
print*,''
print*,''
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)
do j = i+1, mo_num
accu_od += dabs(super_ci_dm(i,j) - super_ci_dm(j,i))

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

@ -54,61 +54,72 @@ END_PROVIDER
endif
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
BEGIN_DOC
! Best eigenvector of the single-excitation matrix
END_DOC
integer :: ierr,matz,i
real*8 :: c0
energy_improvement = SXeigenval(1)
integer :: best_vector
real*8 :: best_overlap
best_overlap=0.D0
best_vector = -1000
integer :: i
double precision :: c0
c0=SXeigenvec(1,best_vector_ovrlp_casscf)
do i=1,nMonoEx+1
if (SXeigenval(i).lt.0.D0) then
if (abs(SXeigenvec(1,i)).gt.best_overlap) then
best_overlap=abs(SXeigenvec(1,i))
best_vector=i
end if
end if
SXvector(i)=SXeigenvec(i,best_vector_ovrlp_casscf)/c0
end do
if(best_vector.lt.0)then
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
END_PROVIDER
BEGIN_PROVIDER [real*8, NewOrbs, (ao_num,mo_num) ]
BEGIN_PROVIDER [double precision, NewOrbs, (ao_num,mo_num) ]
implicit none
BEGIN_DOC
! Updated orbitals
END_DOC
integer :: i,j,ialph
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))
if(state_following_casscf)then
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))
else
NewOrbs = superci_natorb
endif
END_PROVIDER