      subroutine diff0(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,e)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      common/opt/ihab,calcul
      character*3 calcul
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/orb2/numina(maxorb),numvir(maxorb),iordo(maxorb*2)
     *,iodro(maxorb*2)
     *,numinb(maxorb),numvib(maxorb)
      common/l40/ hmono(maxorb*(maxorb+1)/2),aj(maxorb*(maxorb+1)/2)
     *,ak(maxorb*(maxorb+1)/2),f(maxorb*(maxorb+1)/2),e0
     *,ajk(maxorb*(maxorb+1)/2),escf
      common/g2/lg2,ig2,lg2p,ig2p,lg2m,ig2m,ng2,yg2,yga2
c      num(i,j)=i*(i-1)/2+j
      num(i,j)=max0(i,j)*(max0(i,j)-1)/2+min(i,j)
      yw=.false.
      nta=(nt+ispt)/2
      npa=(np+ispp)/2
      ntb=nt-nta
      npb=np-npa
      e=e0
      if(yw)print*,'ELDIA E0',e0
      do i=1,nca
         i1=ica(i)
         e=e+f(num(i1,i1))
         if(yw)print*,'ELDIA FOCK',i,i1,f(num(i1,i1))
         do j=1,i-1
            i2=ica(j)
            e=e+ajk(num(i1,i2))
            if(yw)print*,'ELDIA AA AJK',i,i1,j,i2,ajk(num(i1,i2))
         enddo
         do j=1,ncb
            i2=icb(j)
            ig=max0(i1,i2)
            ipet=min(i1,i2)
            e=e+aj(num(ig,ipet))
            if(yw)print*,'ELDIA AA AJ',i,i1,j,i2,aj(num(ig,ipet))
         enddo
         do j=1,npa
            i2=ip(j)
            e=e+ajk(num(i1,i2))
            if(yw)print*,'ELDIA AP AJK',i,i1,j,i2,ajk(num(i1,i2))
         enddo
         do j=1,npb
            i2=iorb(ip(j+npa))
            e=e+aj(num(i1,i2))
            if(yw)print*,'ELDIA AP AJ',i,i1,j,i2,aj(num(i1,i2))
         enddo
         do j=1,nta
            i2=it(j)
            e=e-ajk(num(i1,i2))
            if(yw)print*,'ELDIA AT AJK',i,i1,j,i2,-ajk(num(i1,i2))
         enddo
         do j=1,ntb
            i2=iorb(it(j+nta))
            e=e-aj(num(i1,i2))
            if(yw)print*,'ELDIA AT AJ',i,i1,j,i2,-aj(num(i1,i2))
         enddo
      enddo
      do i=1,ncb
         i1=icb(i)
         e=e+f(num(i1,i1))
         if(yw)print*,'ELDIB FOCK',i,i1,f(num(i1,i1))
         do j=1,i-1
            i2=icb(j)
            e=e+ajk(num(i1,i2))
            if(yw)print*,'ELDIB AA AJK',i,i1,j,i2,ajk(num(i1,i2))
         enddo
         do j=1,npa
            i2=ip(j)
            e=e+aj(num(i1,i2))
            if(yw)print*,'ELDIB AP AJ',i,i1,j,i2,aj(num(i1,i2))
         enddo
         do j=1,npb
            i2=iorb(ip(j+npa))
            e=e+ajk(num(i1,i2))
            if(yw)print*,'ELDIB AP AJK',i,i1,j,i2,ajk(num(i1,i2))
         enddo
         do j=1,nta
            i2=it(j)
            e=e-aj(num(i1,i2))
            if(yw)print*,'ELDIB AT -AJ',i,i1,j,i2,-aj(num(i1,i2))
         enddo
         do j=1,ntb
            i2=iorb(it(j+nta))
            e=e-ajk(num(i1,i2))
            if(yw)print*,'ELDIB AT -AJK',i,i1,j,i2,-ajk(num(i1,i2))
         enddo
      enddo
      do i=1,npa
         i1=iorb(ip(i))
         e=e+f(num(i1,i1))
         if(yw)write(6,*)'diff0  f npa',i1,f(num(i1,i1))
         do j=1,i-1
            i2=iorb(ip(j))
            e=e+ajk(num(i1,i2))
            if(yw)write(6,*)'diff0 ajk',i1,i2,+ajk(num(i1,i2))
         enddo
         do j=1,npb
            i2=iorb(ip(j+npa))
            ig=max0(i1,i2)
            ipet=min(i1,i2)
            e=e+aj(num(ig,ipet))
            if(yw)write(6,*)'diff0 aj',i1,i2,aj(num(ig,ipet))
         enddo
         do j=1,nta
            i2=iorb(it(j))
            e=e-ajk(num(i1,i2))
            if(yw)write(6,*)'diff0 -ajk',i1,i2,-ajk(num(i1,i2))
         enddo
         do j=1,ntb
            i2=iorb(it(j+nta))
            e=e-aj(num(i1,i2))
            if(yw)write(6,*)'diff0 -aj',i1,i2,-aj(num(i1,i2))
         enddo
      enddo
      do i=1,npb
         i1=iorb(ip(i+npa))
         e=e+f(num(i1,i1))
         if(yw)write(6,*)'diff0 P fock',i1,f(num(i1,i1))
         do j=1,i-1
            e=e+ajk(num(i1,iorb(ip(j+npa))))
            if(yw)write(6,*)'diff0 ajk',i1,iorb(ip(j+npa))
     *      ,ajk(num(i1,iorb(ip(j+npa))))
         enddo
         do j=1,nta
            i2=iorb(it(j))
            e=e-aj(num(i1,i2))
            if(yw)write(6,*)'diff0 -aj',i1,i2,-aj(num(i1,i2))
         enddo
         do j=1,ntb
            i2=iorb(it(j+nta))
            e=e-ajk(num(i1,i2))
            if(yw)write(6,*)'diff0 -ajk',i1,i2,-ajk(num(i1,i2))
         enddo
      enddo
      do i=1,nta
         i1=iorb(it(i))
         e=e-f(num(i1,i1))
         if(yw)write(6,*)'diff0 Ta -fock',i1,-f(num(i1,i1))
         do j=1,i-1
            e=e+ajk(num(i1,it(j)))
            if(yw)write(6,*)'diff0 -ajk',i1,it(j),ajk(num(i1,it(j)))
         enddo
         do j=1,ntb
            i2=iorb(it(j+nta))
            ig=max0(i1,i2)
            ipet=min(i1,i2)
            e=e+aj(num(ig,ipet))
            if(yw)write(6,*)'diff0 aj',i1,i2,aj(num(ig,ipet))
         enddo
      enddo
      do i=1,ntb
         i1=iorb(it(i+nta))
         e=e-f(num(i1,i1))
         if(yw)write(6,*)'diff0 Tb -fock',i1,-f(num(i1,i1))
         do j=1,i-1
            e=e+ajk(num(i1,iorb(it(j+nta))))
            if(yw)write(6,*)'diff0 -1',i1,iorb(it(j+nta))
     *      ,ajk(num(i1,iorb(it(j+nta))))
         enddo
      enddo
      if(yw)print*,'ELD E',e
      if(calcul.eq.'M')call stover(iadr1,iadr1,e*0.5d0)
      if(yw)write(6,*)'e diag',e,nta,ntb,npa,npb
      return
      end
       subroutine diff0g(nca,ica,ncb,icb,nt,it,ispt
     * ,np,ip,ispp,iadr1,e)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      common/dim/iadri ; integer(8) iadri
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      dimension jt(2),jp(2)
      common /det/ndet,mdet(50),nbdet_cas
      common/l40/ g2(maxorb,maxorb),g2a(maxorb*(maxorb+1)/2)
     *,g2b(maxorb*(maxorb+1)/2),dum(3*maxorb*(maxorb+1)/2
     *-maxorb*maxorb+2)
      common/orb2/numina(maxorb),numvir(maxorb),iordo(maxorb*2)
     *,iodro(maxorb*2)
     *,numinb(maxorb),numvib(maxorb)
      common/g2/lg2,ig2,lg2p,ig2p,lg2m,ig2m,ng2,yg2,yga2
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      dimension ya(maxorb),yb(maxorb)
      yw=.false.
      if(yw)print*,'entree diff0g'
       nta=(nt+ispt)/2
       npa=(np+ispp)/2
       ntb=nt-nta
       npb=np-npa
          ee=e*e
          do k=1,nta
             jt(k)=numina(it(k))
          enddo
          do k=1,ntb
             jt(k+nta)=numina(iorb(it(k)))
          enddo
          do k=1,npa
             jp(k)=numvir(ip(k))
          enddo
          do k=1,npb
             jp(k+npa)=numvir(iorb(ip(k)))
          enddo
 	   do k=1,ninac
 	      ya(k)=.true.
 	      yb(k)=.true.
 	   enddo
 	   do k=ninac+1,norb
 	      ya(k)=.false.
 	      yb(k)=.false.
 	   enddo
 	   do k=1,nca
 	      ya(ica(k))=.true.
 	   enddo
 	   do k=1,ncb
 	      yb(icb(k))=.true.
 	   enddo
 	   do k=1,nta
 	      ya(it(k))=.false.
 	   enddo
 	   do k=1,ntb
 	      yb(iorb(it(k+nta)))=.false.
 	   enddo
 	   do k=1,npa
 	      ya(ip(k))=.true.
 	   enddo
 	   do k=1,npb
 	      yb(iorb(ip(k+npa)))=.true.
 	   enddo
       nt=nta+ntb
       np=npa+npb
       if(yw)print*,'nta,ntb,npa,npb',nta,ntb,npa,npb
       if(yw)print*,'it',(it(k),k=1,nt),'  ip',(ip(k),k=1,np)
       if(yw)print*,'ica',(ica(k),k=1,nca),'  icb',(icb(k),k=1,ncb)
       if(yw)print*,'ya',(ya(k),k=1,norb)
       if(yw)print*,'yb',(yb(k),k=1,norb)
 	   do k=1,norb
 	      if(ya(k)) then
 	         kk=(k-2)*(k-1)/2
 	         do l=1,k-1
 	            if(ya(l)) g2a(kk+l)=g2a(kk+l)+ee
 	         enddo
 	      do l=1,norb
 	         if(yb(l)) g2(k,l)=g2(k,l)+ee
 	      enddo
 	      endif
 	   enddo
 	   do k=1,norb
 	      if(yb(k)) then
 	         kk=(k-2)*(k-1)/2
 	         do l=1,k-1
 	            if(yb(l)) g2b(kk+l)=g2b(kk+l)+ee
 	         enddo
 	      endif
 	   enddo
	return
	end
