      subroutine diff1c
     *(nca,ica,ncb,icb,nt,it,ispt,np,ip,ispp,iadr1,
     *b,ab,coef)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
c
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    |      b        |      ab       |
c
      common/dim/iadri ; integer(8) iadri
      common/opt/ihab,calcul
      character*3 calcul
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      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 /prep/ nca0,ncb0,ic0(maxorbcas),icamun(maxorb+maxorb)
     *,numt(maxorb),nump(maxorb),nv
     *,gener,yoc(maxorb+maxorb),yrefc(maxorbcas),yac(maxorb)
     *,ygmono,ygddci,ygddc2,ygcas,ygtous
      character*4 gener
      dimension ica(maxorbcas),icb(maxorbcas),it(2),ip(2)
      dimension ictemp(maxorb),icd(maxorb)
      dimension b(iadri),ab(iadri)
      common/test/itest(100)
      yw=.false.
c
c-----------------------------------------------------------
c     une difference  deplacement d'un electron du CAS
c-----------------------------------------------------------
c
      nta=(nt+ispt)/2
      npa=(np+ispp)/2
      ntb=nt-nta
      npb=np-npa
      ynon=.false.
      b0=b(iadr1)
      if(yw)write(6,*)'diff1c nca',nca
      call comple(noac,numac,nca,ica,ncd,icd)
c--------boucle sur l'electron supprime
      do i=1,nca
         is1=itsym(ica(i))
c        ica(i) est l'electron supprime
         if(yw)write(6,*)'diff1c electron supprime',ica(i)
c-------------boucle sur l'electron cree
         do j=1,ncd
            if(icd(j).lt.ica(i)) goto 1
            if(is1.ne.itsym(icd(j))) goto 1
            if(yw)write(6,*)'diff1c electron cree',icd(j)
c           icd(j) est le electron cree
            mini=min(ica(i),icd(j))
            maxi=max0(ica(i),icd(j))
            do k=1,nca
               ictemp(k)=ica(k)
            enddo
            ictemp(i)=icd(j)
            call reor(nca,ictemp,isgn)
            if(yw)write(6,*)'ictemp',(ictemp(kk),kk=1,nca)
            if(gener(1:2).eq.'MR')
     *      call accept(nca,ictemp,ncb,icb,nt,np,ynon)
            if(ynon) goto 1
            call adrdet
     *      (nca,ictemp,ncb,icb,nt,it,ispt,np,ip,ispp,iadr2,
     *      mhdum,mtdum)
c------------------calcul de l'integrale
            a=f(maxi*(maxi-1)/2+mini)
            if(yw)write(6,*)'diff1c a f', a
c------------------
            if(yw)write(6,*)'diff1c adresses,int',iadr1,iadr2,a
            if(calcul.eq.'M') then
               call stover(iadr1,iadr2,a*isgn*coef)
            else
               aa=a*isgn*coef
CIT17           if(itest(17).eq.iadr2)write(6,'('' diff1c it17'',i5,2f12
CIT17        *   iadr1,aa,b(iadr1)
CIT17           if(itest(17).eq.iadr1)write(6,'('' diff1c it17'',i5,2f12
CIT17        *   iadr2,aa,b(iadr2)
               ab(iadr2)=ab(iadr2)+aa*b0
               ab(iadr1)=ab(iadr1)+aa*b(iadr2)
            endif
 1          continue
         enddo
      enddo
      call comple(noac,numac,ncb,icb,ncd,icd)
c--------boucle sur l'electron supprime
      do i=1,ncb
         is1=itsym(icb(i))
c        icb(i) est l'electron supprime
         if(yw)write(6,*)'diff1c electron supprime',icb(i)
c-------------boucle sur l'electron cree
         do j=1,ncd
            if(icd(j).lt.icb(i)) goto 2
            if(is1.ne.itsym(icd(j))) goto 2
            if(yw)write(6,*)'diff1c electron cree',icd(j)
c           icd(j) est l'electron cree
            mini=min(icb(i),icd(j))
            maxi=max0(icb(i),icd(j))
            do k=1,ncb
               ictemp(k)=icb(k)
            enddo
            ictemp(i)=icd(j)
            call reor(ncb,ictemp,isgn)
            if(yw)write(6,*)'ica',(ica(kk),kk=1,nca)
            if(yw)write(6,*)'ictemp',(ictemp(kk),kk=1,ncb)
            if(gener(1:2).eq.'MR')
     *      call accept(nca,ica,ncb,ictemp,nt,np,ynon)
            if(ynon) goto 2
            call adrdet
     *      (nca,ica,ncb,ictemp,nt,it,ispt,np,ip,ispp,iadr2,
     *      mhdum,mtdum)
c------------------calcul de l'integrale
            a=f(maxi*(maxi-1)/2+mini)
c------------------
            if(yw)write(6,*)
     *      'diff1c adresses,int,isgn',iadr1,iadr2,a,isgn
            if(calcul.eq.'M') then
               call stover(iadr1,iadr2,a*isgn*coef)
            else
               aa=a*isgn*coef
CIT17           if(itest(17).eq.iadr2)write(6,'('' diff1c it17'',i5,2f12
CIT17        *   iadr1,aa,b(iadr1)
CIT17           if(itest(17).eq.iadr1)write(6,'('' diff1c it17'',i5,2f12
CIT17        *   iadr2,aa,b(iadr2)
               ab(iadr2)=ab(iadr2)+aa*b0
               ab(iadr1)=ab(iadr1)+aa*b(iadr2)
            endif
 2          continue
         enddo
      enddo
      return
      end
