qp2/src/casscf/tot_en.irp.f

 BEGIN_PROVIDER [real*8, etwo]
&BEGIN_PROVIDER [real*8, eone]
&BEGIN_PROVIDER [real*8, eone_bis]
&BEGIN_PROVIDER [real*8, etwo_bis]
&BEGIN_PROVIDER [real*8, etwo_ter]
&BEGIN_PROVIDER [real*8, ecore]
&BEGIN_PROVIDER [real*8, ecore_bis]
   implicit none
   integer                        :: t,u,v,x,i,ii,tt,uu,vv,xx,j,jj,t3,u3,v3,x3
   real*8                         :: e_one_all,e_two_all
   e_one_all=0.D0
   e_two_all=0.D0
   do i=1,n_core_inact_orb
     ii=list_core_inact(i)
     e_one_all+=2.D0*mo_one_e_integrals(ii,ii)
     do j=1,n_core_inact_orb
       jj=list_core_inact(j)
       e_two_all+=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i)
     end do
     do t=1,n_act_orb
       tt=list_act(t)
       t3=t+n_core_inact_orb
       do u=1,n_act_orb
         uu=list_act(u)
         u3=u+n_core_inact_orb
         e_two_all+=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i)           &
             -bielec_PQxx(tt,ii,i,u3))
       end do
     end do
   end do
   do t=1,n_act_orb
     tt=list_act(t)
     do u=1,n_act_orb
       uu=list_act(u)
       e_one_all+=D0tu(t,u)*mo_one_e_integrals(tt,uu)
       do v=1,n_act_orb
         v3=v+n_core_inact_orb
         do x=1,n_act_orb
           x3=x+n_core_inact_orb
           e_two_all  +=P0tuvx(t,u,v,x)*bielec_PQxx(tt,uu,v3,x3)
         end do
       end do
     end do
   end do
   ecore    =nuclear_repulsion
   ecore_bis=nuclear_repulsion
   do i=1,n_core_inact_orb
     ii=list_core_inact(i)
     ecore    +=2.D0*mo_one_e_integrals(ii,ii)
     ecore_bis+=2.D0*mo_one_e_integrals(ii,ii)
     do j=1,n_core_inact_orb
       jj=list_core_inact(j)
       ecore    +=2.D0*bielec_PQxx(ii,ii,j,j)-bielec_PQxx(ii,jj,j,i)
       ecore_bis+=2.D0*bielec_PxxQ(ii,i,j,jj)-bielec_PxxQ(ii,j,j,ii)
     end do
   end do
   eone    =0.D0
   eone_bis=0.D0
   etwo    =0.D0
   etwo_bis=0.D0
   etwo_ter=0.D0
   do t=1,n_act_orb
     tt=list_act(t)
     t3=t+n_core_inact_orb
     do u=1,n_act_orb
       uu=list_act(u)
       u3=u+n_core_inact_orb
       eone    +=D0tu(t,u)*mo_one_e_integrals(tt,uu)
       eone_bis+=D0tu(t,u)*mo_one_e_integrals(tt,uu)
       do i=1,n_core_inact_orb
         ii=list_core_inact(i)
         eone    +=D0tu(t,u)*(2.D0*bielec_PQxx(tt,uu,i,i)            &
             -bielec_PQxx(tt,ii,i,u3))
         eone_bis+=D0tu(t,u)*(2.D0*bielec_PxxQ(tt,u3,i,ii)           &
             -bielec_PxxQ(tt,i,i,uu))
       end do
       do v=1,n_act_orb
         vv=list_act(v)
         v3=v+n_core_inact_orb
         do x=1,n_act_orb
           xx=list_act(x)
           x3=x+n_core_inact_orb
           real*8                         :: h1,h2,h3
           h1=bielec_PQxx(tt,uu,v3,x3)
           h2=bielec_PxxQ(tt,u3,v3,xx)
           h3=bielecCI(t,u,v,xx)
           etwo    +=P0tuvx(t,u,v,x)*h1
           etwo_bis+=P0tuvx(t,u,v,x)*h2
           etwo_ter+=P0tuvx(t,u,v,x)*h3
           if ((h1.ne.h2).or.(h1.ne.h3)) then
             write(6,9901) t,u,v,x,h1,h2,h3
             9901 format('aie: ',4I4,3E20.12)
           end if
         end do
       end do
     end do
   end do
   
END_PROVIDER