mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-19 06:01:31 +02:00
Cleaned neworbs
This commit is contained in:
parent
6531181316
commit
5902f3231e
@ -21,10 +21,6 @@ subroutine run
|
|||||||
call run_cipsi
|
call run_cipsi
|
||||||
|
|
||||||
write(6,*) ' total energy = ',eone+etwo+ecore
|
write(6,*) ' total energy = ',eone+etwo+ecore
|
||||||
mo_label = "MCSCF"
|
|
||||||
mo_label = "Natural"
|
|
||||||
mo_coef(:,:) = NatOrbsFCI(:,:)
|
|
||||||
call save_mos
|
|
||||||
|
|
||||||
call driver_optorb
|
call driver_optorb
|
||||||
energy_old = energy
|
energy_old = energy
|
||||||
|
@ -1,7 +1,11 @@
|
|||||||
! -*- F90 -*-
|
|
||||||
BEGIN_PROVIDER [real*8, SXmatrix, (nMonoEx+1,nMonoEx+1)]
|
BEGIN_PROVIDER [real*8, SXmatrix, (nMonoEx+1,nMonoEx+1)]
|
||||||
implicit none
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Single-excitation matrix
|
||||||
|
END_DOC
|
||||||
|
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
|
||||||
do i=1,nMonoEx+1
|
do i=1,nMonoEx+1
|
||||||
do j=1,nMonoEx+1
|
do j=1,nMonoEx+1
|
||||||
SXmatrix(i,j)=0.D0
|
SXmatrix(i,j)=0.D0
|
||||||
@ -31,15 +35,22 @@ END_PROVIDER
|
|||||||
|
|
||||||
BEGIN_PROVIDER [real*8, SXeigenvec, (nMonoEx+1,nMonoEx+1)]
|
BEGIN_PROVIDER [real*8, SXeigenvec, (nMonoEx+1,nMonoEx+1)]
|
||||||
&BEGIN_PROVIDER [real*8, SXeigenval, (nMonoEx+1)]
|
&BEGIN_PROVIDER [real*8, SXeigenval, (nMonoEx+1)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Eigenvectors/eigenvalues of the single-excitation matrix
|
||||||
|
END_DOC
|
||||||
|
call lapack_diag(SXeigenval,SXeigenvec,SXmatrix,nMonoEx+1,nMonoEx+1)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [real*8, SXvector, (nMonoEx+1)]
|
BEGIN_PROVIDER [real*8, SXvector, (nMonoEx+1)]
|
||||||
&BEGIN_PROVIDER [real*8, energy_improvement]
|
&BEGIN_PROVIDER [real*8, energy_improvement]
|
||||||
implicit none
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Best eigenvector of the single-excitation matrix
|
||||||
|
END_DOC
|
||||||
integer :: ierr,matz,i
|
integer :: ierr,matz,i
|
||||||
real*8 :: c0
|
real*8 :: c0
|
||||||
|
|
||||||
call lapack_diag(SXeigenval,SXeigenvec,SXmatrix,nMonoEx+1,nMonoEx+1)
|
|
||||||
write(6,*) ' SXdiag : lowest 5 eigenvalues '
|
write(6,*) ' SXdiag : lowest 5 eigenvalues '
|
||||||
write(6,*) ' 1 - ',SXeigenval(1),SXeigenvec(1,1)
|
write(6,*) ' 1 - ',SXeigenval(1),SXeigenvec(1,1)
|
||||||
write(6,*) ' 2 - ',SXeigenval(2),SXeigenvec(1,2)
|
write(6,*) ' 2 - ',SXeigenval(2),SXeigenvec(1,2)
|
||||||
@ -78,53 +89,32 @@ END_PROVIDER
|
|||||||
|
|
||||||
BEGIN_PROVIDER [real*8, NewOrbs, (ao_num,mo_num) ]
|
BEGIN_PROVIDER [real*8, NewOrbs, (ao_num,mo_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Updated orbitals
|
||||||
|
END_DOC
|
||||||
integer :: i,j,ialph
|
integer :: i,j,ialph
|
||||||
|
|
||||||
! form the exponential of the Orbital rotations
|
call dgemm('N','T', ao_num,mo_num,mo_num,1.d0, &
|
||||||
call get_orbrotmat
|
NatOrbsFCI, size(NatOrbsFCI,1), &
|
||||||
! form the new orbitals
|
Umat, size(Umat,1), 0.d0, &
|
||||||
do i=1,ao_num
|
NewOrbs, size(NewOrbs,1))
|
||||||
do j=1,mo_num
|
|
||||||
NewOrbs(i,j)=0.D0
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
do ialph=1,ao_num
|
|
||||||
do i=1,mo_num
|
|
||||||
wrkline(i)=mo_coef(ialph,i)
|
|
||||||
end do
|
|
||||||
do i=1,mo_num
|
|
||||||
do j=1,mo_num
|
|
||||||
NewOrbs(ialph,i)+=Umat(i,j)*wrkline(j)
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [real*8, Tpotmat, (mo_num,mo_num) ]
|
BEGIN_PROVIDER [real*8, Umat, (mo_num,mo_num) ]
|
||||||
&BEGIN_PROVIDER [real*8, Umat, (mo_num,mo_num) ]
|
|
||||||
&BEGIN_PROVIDER [real*8, wrkline, (mo_num) ]
|
|
||||||
&BEGIN_PROVIDER [real*8, Tmat, (mo_num,mo_num) ]
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
subroutine get_orbrotmat
|
|
||||||
implicit none
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Orbital rotation matrix
|
||||||
|
END_DOC
|
||||||
integer :: i,j,indx,k,iter,t,a,ii,tt,aa
|
integer :: i,j,indx,k,iter,t,a,ii,tt,aa
|
||||||
real*8 :: sum
|
|
||||||
logical :: converged
|
logical :: converged
|
||||||
|
|
||||||
|
real*8 :: Tpotmat (mo_num,mo_num), Tpotmat2 (mo_num,mo_num)
|
||||||
|
real*8 :: Tmat(mo_num,mo_num)
|
||||||
|
real*8 :: f
|
||||||
|
|
||||||
! the orbital rotation matrix T
|
! the orbital rotation matrix T
|
||||||
do i=1,mo_num
|
Tmat(:,:)=0.D0
|
||||||
do j=1,mo_num
|
|
||||||
Tmat(i,j)=0.D0
|
|
||||||
Umat(i,j)=0.D0
|
|
||||||
Tpotmat(i,j)=0.D0
|
|
||||||
end do
|
|
||||||
Tpotmat(i,i)=1.D0
|
|
||||||
end do
|
|
||||||
|
|
||||||
indx=1
|
indx=1
|
||||||
do i=1,n_core_orb
|
do i=1,n_core_orb
|
||||||
ii=list_core(i)
|
ii=list_core(i)
|
||||||
@ -154,69 +144,29 @@ END_PROVIDER
|
|||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
write(6,*) ' the T matrix '
|
! Form the exponential
|
||||||
do indx=1,nMonoEx
|
|
||||||
i=excit(1,indx)
|
|
||||||
j=excit(2,indx)
|
|
||||||
! if (abs(Tmat(i,j)).gt.1.D0) then
|
|
||||||
! write(6,*) ' setting matrix element ',i,j,' of ',Tmat(i,j),' to ' &
|
|
||||||
! , sign(1.D0,Tmat(i,j))
|
|
||||||
! Tmat(i,j)=sign(1.D0,Tmat(i,j))
|
|
||||||
! Tmat(j,i)=-Tmat(i,j)
|
|
||||||
! end if
|
|
||||||
if (abs(Tmat(i,j)).gt.1.D-9) write(6,9901) i,j,excit_class(indx),Tmat(i,j)
|
|
||||||
9901 format(' ',i4,' -> ',i4,' (',A3,') : ',E14.6)
|
|
||||||
end do
|
|
||||||
|
|
||||||
write(6,*)
|
Tpotmat(:,:)=0.D0
|
||||||
write(6,*) ' forming the matrix exponential '
|
Umat(:,:) =0.D0
|
||||||
write(6,*)
|
do i=1,mo_num
|
||||||
! form the exponential
|
Tpotmat(i,i)=1.D0
|
||||||
|
Umat(i,i) =1.d0
|
||||||
|
end do
|
||||||
iter=0
|
iter=0
|
||||||
converged=.false.
|
converged=.false.
|
||||||
do while (.not.converged)
|
do while (.not.converged)
|
||||||
iter+=1
|
iter+=1
|
||||||
! add the next term
|
f = 1.d0 / dble(iter)
|
||||||
do i=1,mo_num
|
Tpotmat2(:,:) = Tpotmat(:,:) * f
|
||||||
do j=1,mo_num
|
call dgemm('N','N', mo_num,mo_num,mo_num,1.d0, &
|
||||||
Umat(i,j)+=Tpotmat(i,j)
|
Tpotmat2, size(Tpotmat2,1), &
|
||||||
end do
|
Tmat, size(Tmat,1), 0.d0, &
|
||||||
end do
|
Tpotmat, size(Tpotmat,1))
|
||||||
! next power of T, we multiply Tpotmat with Tmat/iter
|
Umat(:,:) = Umat(:,:) + Tpotmat(:,:)
|
||||||
do i=1,mo_num
|
|
||||||
do j=1,mo_num
|
|
||||||
wrkline(j)=Tpotmat(i,j)/dble(iter)
|
|
||||||
Tpotmat(i,j)=0.D0
|
|
||||||
end do
|
|
||||||
do j=1,mo_num
|
|
||||||
do k=1,mo_num
|
|
||||||
Tpotmat(i,j)+=wrkline(k)*Tmat(k,j)
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
! Convergence test
|
|
||||||
sum=0.D0
|
|
||||||
do i=1,mo_num
|
|
||||||
do j=1,mo_num
|
|
||||||
sum+=abs(Tpotmat(i,j))
|
|
||||||
end do
|
|
||||||
end do
|
|
||||||
write(6,*) ' Iteration No ',iter,' Sum = ',sum
|
|
||||||
if (sum.lt.1.D-6) then
|
|
||||||
converged=.true.
|
|
||||||
end if
|
|
||||||
if (iter.ge.NItExpMax) then
|
|
||||||
stop ' no convergence '
|
|
||||||
end if
|
|
||||||
end do
|
|
||||||
write(6,*)
|
|
||||||
write(6,*) ' Converged ! '
|
|
||||||
write(6,*)
|
|
||||||
|
|
||||||
end subroutine get_orbrotmat
|
converged = ( sum(abs(Tpotmat(:,:))) < 1.d-6).or.(iter>30)
|
||||||
|
end do
|
||||||
BEGIN_PROVIDER [integer, NItExpMax]
|
|
||||||
NItExpMax=100
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user