diff --git a/src/casscf/EZFIO.cfg b/src/casscf/EZFIO.cfg index ce51a064..48e296a5 100644 --- a/src/casscf/EZFIO.cfg +++ b/src/casscf/EZFIO.cfg @@ -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 + + diff --git a/src/casscf/bavard.irp.f b/src/casscf/bavard.irp.f index 0049ea95..2311966e 100644 --- a/src/casscf/bavard.irp.f +++ b/src/casscf/bavard.irp.f @@ -1,6 +1,6 @@ ! -*- F90 -*- BEGIN_PROVIDER [logical, bavard] - bavard=.true. -! bavard=.false. + bavard=.true. +! bavard=.false. END_PROVIDER diff --git a/src/casscf/get_energy.irp.f b/src/casscf/get_energy.irp.f index 92e5adf5..4ac2b22e 100644 --- a/src/casscf/get_energy.irp.f +++ b/src/casscf/get_energy.irp.f @@ -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)) diff --git a/src/casscf/neworbs.irp.f b/src/casscf/neworbs.irp.f index 0c1026b0..980b4551 100644 --- a/src/casscf/neworbs.irp.f +++ b/src/casscf/neworbs.irp.f @@ -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