mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-31 08:13:43 +02:00
More cleaning
This commit is contained in:
parent
26be853c18
commit
6531181316
@ -19,7 +19,13 @@ subroutine run
|
||||
N_det = 1
|
||||
TOUCH N_det psi_det psi_coef
|
||||
call run_cipsi
|
||||
call driver_wdens
|
||||
|
||||
write(6,*) ' total energy = ',eone+etwo+ecore
|
||||
mo_label = "MCSCF"
|
||||
mo_label = "Natural"
|
||||
mo_coef(:,:) = NatOrbsFCI(:,:)
|
||||
call save_mos
|
||||
|
||||
call driver_optorb
|
||||
energy_old = energy
|
||||
energy = eone+etwo+ecore
|
||||
|
@ -1,52 +0,0 @@
|
||||
subroutine driver_wdens
|
||||
implicit none
|
||||
integer :: istate,p,q,r,s,indx,i,j
|
||||
|
||||
|
||||
write(6,*) ' total energy = ',eone+etwo+ecore
|
||||
write(6,*) ' generating natural orbitals '
|
||||
write(6,*)
|
||||
write(6,*)
|
||||
|
||||
write(6,*) ' all data available ! '
|
||||
write(6,*) ' writing out files '
|
||||
|
||||
call trf_to_natorb
|
||||
real*8 :: approx,np,nq,nr,ns
|
||||
logical :: lpq,lrs,lps,lqr
|
||||
|
||||
open(unit=12,form='formatted',status='unknown',file='onetrf.tmp')
|
||||
indx=0
|
||||
do q=1,mo_num
|
||||
do p=q,mo_num
|
||||
if (abs(onetrf(p,q)).gt.1.D-12) then
|
||||
write(12,'(2i6,E20.12)') p,q,onetrf(p,q)
|
||||
indx+=1
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
write(6,*) ' wrote ',indx,' mono-electronic integrals'
|
||||
close(12)
|
||||
|
||||
|
||||
write(6,*)
|
||||
write(6,*) ' creating new orbitals '
|
||||
do i=1,mo_num
|
||||
write(6,*) ' Orbital No ',i
|
||||
write(6,'(5F14.6)') (NatOrbsFCI(j,i),j=1,mo_num)
|
||||
write(6,*)
|
||||
end do
|
||||
|
||||
mo_label = "MCSCF"
|
||||
mo_label = "Natural"
|
||||
do i=1,mo_num
|
||||
do j=1,ao_num
|
||||
mo_coef(j,i)=NatOrbsFCI(j,i)
|
||||
end do
|
||||
end do
|
||||
call save_mos
|
||||
|
||||
write(6,*) ' ... done '
|
||||
|
||||
end
|
||||
|
@ -7,7 +7,7 @@ BEGIN_PROVIDER [real*8, Fipq, (mo_num,mo_num) ]
|
||||
|
||||
do q=1,mo_num
|
||||
do p=1,mo_num
|
||||
Fipq(p,q)=one_ints(p,q)
|
||||
Fipq(p,q)=one_ints_no(p,q)
|
||||
end do
|
||||
end do
|
||||
|
||||
|
@ -158,14 +158,14 @@ END_PROVIDER
|
||||
|
||||
|
||||
|
||||
BEGIN_PROVIDER [real*8, onetrf, (mo_num,mo_num)]
|
||||
BEGIN_PROVIDER [real*8, one_ints_no, (mo_num,mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Transformed one-e integrals
|
||||
END_DOC
|
||||
integer :: i,j, p, pp, q
|
||||
real*8 :: d(n_act_orb)
|
||||
onetrf(:,:)=mo_one_e_integrals(:,:)
|
||||
one_ints_no(:,:)=mo_one_e_integrals(:,:)
|
||||
|
||||
! 1st half-trf
|
||||
do j=1,mo_num
|
||||
@ -175,11 +175,11 @@ BEGIN_PROVIDER [real*8, onetrf, (mo_num,mo_num)]
|
||||
do p=1,n_act_orb
|
||||
pp=n_act_orb-p+1
|
||||
do q=1,n_act_orb
|
||||
d(pp)+=onetrf(list_act(q),j)*natorbsCI(q,p)
|
||||
d(pp)+=one_ints_no(list_act(q),j)*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
onetrf(list_act(p),j)=d(p)
|
||||
one_ints_no(list_act(p),j)=d(p)
|
||||
end do
|
||||
end do
|
||||
|
||||
@ -191,14 +191,14 @@ BEGIN_PROVIDER [real*8, onetrf, (mo_num,mo_num)]
|
||||
do p=1,n_act_orb
|
||||
pp=n_act_orb-p+1
|
||||
do q=1,n_act_orb
|
||||
d(pp)+=onetrf(j,list_act(q))*natorbsCI(q,p)
|
||||
d(pp)+=one_ints_no(j,list_act(q))*natorbsCI(q,p)
|
||||
end do
|
||||
end do
|
||||
do p=1,n_act_orb
|
||||
onetrf(j,list_act(p))=d(p)
|
||||
one_ints_no(j,list_act(p))=d(p)
|
||||
end do
|
||||
end do
|
||||
write(6,*) ' transformed onetrf '
|
||||
write(6,*) ' transformed one_ints '
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
@ -271,7 +271,7 @@ subroutine trf_to_natorb()
|
||||
e_two_all=0.D0
|
||||
do i=1,n_core_orb
|
||||
ii=list_core(i)
|
||||
e_one_all+=2.D0*onetrf(ii,ii)
|
||||
e_one_all+=2.D0*one_ints_no(ii,ii)
|
||||
do j=1,n_core_orb
|
||||
jj=list_core(j)
|
||||
e_two_all+=2.D0*bielec_PQxx_no(ii,ii,j,j)-bielec_PQxx_no(ii,jj,j,i)
|
||||
@ -288,7 +288,7 @@ subroutine trf_to_natorb()
|
||||
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
e_one_all += occnum(list_act(t))*onetrf(tt,tt)
|
||||
e_one_all += occnum(list_act(t))*one_ints_no(tt,tt)
|
||||
do u=1,n_act_orb
|
||||
uu=list_act(u)
|
||||
do v=1,n_act_orb
|
||||
@ -306,8 +306,8 @@ subroutine trf_to_natorb()
|
||||
ecore_bis=nuclear_repulsion
|
||||
do i=1,n_core_orb
|
||||
ii=list_core(i)
|
||||
ecore +=2.D0*onetrf(ii,ii)
|
||||
ecore_bis+=2.D0*onetrf(ii,ii)
|
||||
ecore +=2.D0*one_ints_no(ii,ii)
|
||||
ecore_bis+=2.D0*one_ints_no(ii,ii)
|
||||
do j=1,n_core_orb
|
||||
jj=list_core(j)
|
||||
ecore +=2.D0*bielec_PQxx_no(ii,ii,j,j)-bielec_PQxx_no(ii,jj,j,i)
|
||||
@ -322,8 +322,8 @@ subroutine trf_to_natorb()
|
||||
do t=1,n_act_orb
|
||||
tt=list_act(t)
|
||||
t3=t+n_core_orb
|
||||
eone += occnum(list_act(t))*onetrf(tt,tt)
|
||||
eone_bis += occnum(list_act(t))*onetrf(tt,tt)
|
||||
eone += occnum(list_act(t))*one_ints_no(tt,tt)
|
||||
eone_bis += occnum(list_act(t))*one_ints_no(tt,tt)
|
||||
do i=1,n_core_orb
|
||||
ii=list_core(i)
|
||||
eone += occnum(list_act(t)) * &
|
||||
|
@ -1,26 +0,0 @@
|
||||
! -*- F90 -*-
|
||||
BEGIN_PROVIDER [real*8, one_ints, (mo_num,mo_num)]
|
||||
implicit none
|
||||
integer :: i,j,kk
|
||||
logical :: lread
|
||||
real*8 :: rdum
|
||||
do i=1,mo_num
|
||||
do j=1,mo_num
|
||||
one_ints(i,j)=0.D0
|
||||
end do
|
||||
end do
|
||||
open(unit=12,file='onetrf.tmp',status='old',form='formatted')
|
||||
lread=.true.
|
||||
do while (lread)
|
||||
read(12,*,iostat=kk) i,j,rdum
|
||||
if (kk.ne.0) then
|
||||
lread=.false.
|
||||
else
|
||||
one_ints(i,j)=rdum
|
||||
one_ints(j,i)=rdum
|
||||
end if
|
||||
end do
|
||||
close(12)
|
||||
write(6,*) ' read MCSCF natural one-electron integrals '
|
||||
END_PROVIDER
|
||||
|
Loading…
Reference in New Issue
Block a user