diff --git a/src/casscf/casscf.irp.f b/src/casscf/casscf.irp.f index b55c4c3b..1737c852 100644 --- a/src/casscf/casscf.irp.f +++ b/src/casscf/casscf.irp.f @@ -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 diff --git a/src/casscf/driver_wdens.irp.f b/src/casscf/driver_wdens.irp.f deleted file mode 100644 index 5a3863a3..00000000 --- a/src/casscf/driver_wdens.irp.f +++ /dev/null @@ -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 - diff --git a/src/casscf/mcscf_fock.irp.f b/src/casscf/mcscf_fock.irp.f index 68845eb4..84b87248 100644 --- a/src/casscf/mcscf_fock.irp.f +++ b/src/casscf/mcscf_fock.irp.f @@ -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 diff --git a/src/casscf/natorb.irp.f b/src/casscf/natorb.irp.f index d2cc6736..00c9564c 100644 --- a/src/casscf/natorb.irp.f +++ b/src/casscf/natorb.irp.f @@ -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)) * & diff --git a/src/casscf/one_ints.irp.f b/src/casscf/one_ints.irp.f deleted file mode 100644 index a802f644..00000000 --- a/src/casscf/one_ints.irp.f +++ /dev/null @@ -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 -