      subroutine disin8(cint,b,yh,iappel,ndc,ndr)
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !Lit les files d'integrales particulieres (CDI_.... etc...)
      ! (seulement les int contenant au moins 1 elt di CAS)
      ! Les reecrit dans le meme fichier sous un autre nom
      ! pour les utiliser par blocs dans H.Psi
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter (maxda3=300)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      common/dim/iadri ; integer(8) iadri
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      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
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      character*4 gener
      dimension iadsa(maxorb)
      character*1 cint(ndc)
      dimension yh(ndr)
      dimension b(ndr)
      common/infdav/ twcas,alam(maxda3),tau,twvec,twess,sint,sint4,sh
     *,hab,Nbtots,nvec,ngao,niter,iprec,lvec(maxda3),nfrag,ipresc,irest
     *,jrest
     *,iunit,ihprec,ihvec,ifiess,NESSAI,nf8,maxda2,bidia,ywvec,ytana
     *,yhmono,ydens,ywcas
      logical*1 bidia
      character*4 hab
      common /nin/i3333,ie3333,i1111,ie1111,i3131,ie3131
     *,i3311,ie3311,i3331,ie3331,i1113,ie1113,i0000,ie0000
     *,l3333,le3333,l1111,le1111,l3131,le3131
     *,l3311,le3311,l3331,le3331,l1113,le1113,l0000,le0000
     *,i2333,ie2333,l2333,le2333,i2000,ie2000,l2000,le2000
     *,i2233,ie2233,l2233,le2233,i1122,ie1122,l1122,le1122
     *,i2323,ie2323,l2323,le2323,i1212,ie1212,l1212,le1212
 
     *,i2133,ie2133,l2133,le2133,i2313,ie2313,l2313,le2313
     *,i2311,ie2311,l2311,le2311,i2131,ie2131,l2131,le2131
     *,i2111,ie2111,l2111,le2111,i2123,ie2123,l2123,le2123
     *,i2213,ie2213,l2213,le2213
     *,i211a,i211b,i211c,l211a,l211b,l211c
     *,i2221,i2223,ie2221,ie2223,l2221,l2223,le2221,le2223
     *,i2222,ie2222,l2222,le2222
      common/test/itest(100)
      common/c66/ y66(3,3,3,3),ye66(3,3,3,3)
      if(ygcas) return
      if(irest.eq.1.or.irest.eq.2) then
         open(36,file='CD_DS8',form='unformatted',status='old')
         read(36) y66,ye66
         close(36)
         return
      endif
      yw=.false.
c-------------------------------------------------------
c     mise a zero de y66 : integrales passant par disin8
c-------------------------------------------------------
      if(iappel.eq.1) then
c      if(itest(67).eq.0.and.itest(68).eq.0) then
         do i=1,3
            do j=1,3
               do k=1,3
                  do l=1,3
                     y66(l,k,j,i)=.false.
                     ye66(l,k,j,i)=.false.
                  enddo
               enddo
            enddo
         enddo
         if(itest(66).ne.1) return
      else
         ye66(3,1,3,1)=.false.
         y66(1,1,3,3)=.false.
      endif
c      if(itest(66).eq.0) return
c-------------------------------------------
c     preparation de l'adressage par sym/act
c-------------------------------------------
      do k=1,norb
         iadsa(k)=itsym(k)
      enddo
      do k=1,noac
         iadsa(numac(k))=k
      enddo
      if(yw) then
         do k=1,norb
            print*,'iadsa',k,iadsa(k)
         enddo
      endif
c---------------------------------------------
c     appels a l'ordonnancement des integrales
c---------------------------------------------
      if(norb.lt.256) then
         n=4
      else
         n=5
      endif
      if(iappel.eq.2) then
         if(itest(67).eq.1) then
            call disin9(cint,b,yh,iadsa,'CDE_3131',le3131,ie3131,3,1,3,1
     *      ,n,ndr)
         endif
         if(itest(68).eq.1) then
            call disin9(cint,b,yh,iadsa,'CDI_3311',l3311,i3311,1,1,3,3,n
     *      ,ndr)
         endif
         return
      endif
      call disin9(cint,b,yh,iadsa,'CDE_2111',
     *le2111,ie2111,2,1,1,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2131',
     *le2131,ie2131,2,1,3,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2313',
     *le2313,ie2313,2,3,1,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2311',
     *le2311,ie2311,2,3,1,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2133',
     *le2133,ie2133,2,1,3,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2123',
     *le2123,ie2123,2,1,2,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2213',
     *le2213,ie2213,2,2,1,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_1212',
     *le1212,ie1212,2,1,2,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_1122',
     *le1122,ie1122,2,2,1,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2323',
     *le2323,ie2323,2,3,2,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDE_2233',
     *le2233,ie2233,2,2,3,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2111',l2111,i2111,2,1,1,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2131',l2131,i2131,2,1,3,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2313',l2313,i2313,2,3,1,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2311',l2311,i2311,2,3,1,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2133',l2133,i2133,2,1,3,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2123',l2123,i2123,2,1,2,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2213',l2213,i2213,2,2,1,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_1122',l1122,i1122,2,2,1,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_1212',l1212,i1212,2,1,2,1,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2233',l2233,i2233,2,2,3,3,n,ndr)
      call disin9(cint,b,yh,iadsa,'CDI_2323',l2323,i2323,2,3,2,3,n,ndr)
      if(itest(60).eq.1) then
         call disin9(cint,b,yh,iadsa,'CDI_2221',
     *   l2221,i2221,2,2,2,1,n,ndr)
         call disin9(cint,b,yh,iadsa,'CDE_2221',
     *   le2221,ie2221,2,2,2,1,n
     *   ,ndr)
      endif
      if(itest(61).eq.1) then
         call disin9(cint,b,yh,iadsa,'CDI_2223',
     *   l2223,i2223,2,2,2,3,n,ndr)
         call disin9(cint,b,yh,iadsa,'CDE_2223',
     *   le2223,ie2223,2,2,2,3,n
     *   ,ndr)
      endif
      open(36,file='CD_DS8',form='unformatted',status='unknown')
      write(36) y66,ye66
      close(36)
      return
      end
       subroutine disin9(cint,b,yh,iadsa,file,llll,iiii,iti,itj,itk,itl
     *,n,ndr)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter (maxmax=maxorbcas)
c     maxmax est la valeur maximale de maxorbcas=maxsym
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character*8 file
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      common/dim/iadri ; integer(8) iadri
      common/sy2/ntcps(maxsym,3)
     *,norbs(maxsym)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
c      dimension b(iadri*2)
      dimension iadsa(maxorb)
      dimension nbadsa(maxmax**4),mbadsa(maxmax**4)
c      character*1 cint((iadri*4)/3,4)
c      dimension b((iadri*4)/3)
      character*1 cint(ndr,n)
      dimension b(ndr)
      dimension yh(ndr)
      dimension ltcp(3)
      common/test/itest(100)
      common/c66/ y66(3,3,3,3),ye66(3,3,3,3)
      common/opt/ihab,calcul
      character*3 calcul
      character*5 cond
      yw=.false.
      yw1=.false.
      if(yw1)print*,'entree disin9 file',file
      ye=file(1:3).eq.'CDE'
      yi=file(1:3).eq.'CDI'
      if(yi) y66(iti,itj,itk,itl)=.true.
      if(ye) ye66(iti,itj,itk,itl)=.true.
c----------------------------------------------------
c     calculs preliminaires : adresses de ij et kl
c----------------------------------------------------
c==============================================================
c     Les integrales sont separees en classes
c     - dans <ijkl>, on considere qu'on a l'ordre canonique :
c       i) les C sont le plus a gauche possible
c       ii) en 2eme condition : i<=j ; i<=k ; j<=l
c     - dans <ijkl>, on va distinguer les cas
c       i=j, i<j.  Puis on va placer k par rapport a j et l
c       (5 possibilites)
c       ce qui fait 10 types d'integrales
c       9 en fait, car on ne peut avoir i=j et k<j
c       Tous les raisonnements sur les = et les < concernent seulement
c       les trous et les particules
c       les integrales sont ecrites dans l'ordre d'indices :
c       CCCC CCCv CCvv CvCv Cvvv CCCo CCov CCoo CoCv CoCo Cooo
c       Coov Cvvo Covo Cvov
c       vvvv vvvo
c       oooo ooov oovv ovov
c==============================================================
c
      ltcp(1)=nsym
      ltcp(2)=noac
      ltcp(3)=nsym
      nnnni=ltcp(iti)
      nnnnj=ltcp(itj)
      nnnnk=ltcp(itk)
      nnnnl=ltcp(itl)
      if(iti.eq.2) then
         if(itj.eq.2) then
            if(itk.eq.2) then
               if(itl.eq.2) then
c                 CCCC
                  cond='0'
                  iad0=1
               else
c                 CCCv CCCo
                  cond='CCC'
                  iadfin=nnnnl
                  iadtot=iadfin*nnnni*nnnnj*nnnnk
                  if(yw)print*,'CCC iadtot',iadtot
                  call flush(6)
               endif
            else
               if(itl.eq.itk) then
c                 CCvv CCoo
                  cond='kl'
c                 k=l
                  iad0=nnnnl
c                 k>l
                  iad1=iad0+nnnnk*nnnnl
c                 k<l
                  iadfin=iad1+nnnnk*nnnnl
                  if(ye) iadfin=iad1
                  iadtot=iadfin*nnnni*nnnnj
                  if(yw)print*,'iadfin'
     *            ,iadfin
                  if(yw)print*,'iadtot',iadtot
                  call flush(6)
               else
c                 CCov
                  cond='0'
                  iadfin=nnnnk*nnnnl
                  iadtot=iadfin*nnnni*nnnnj
               endif
            endif
         else
            if(itk.eq.2) then
               if(itj.eq.itl) then
c                 CvCv CoCo
                  cond='jl'
c                 k=l
                  iad0=nnnnl
c                 k>l
                  iad1=iad0+nnnnj*(nnnnj+1)/2
                  if(yi)iad1=iad0
c                 k<l
                  iadfin=iad1+nnnnj*(nnnnj+1)/2
                  iadtot=iadfin*nnnni*nnnnk
                  if(yw)print*,'jl iad0,iadfin,iadtot'
     *            ,iad0,iadfin,iadtot
               else
c                 CoCv
                  cond='CoCv'
                  iadfin=nnnnj*nnnnl
                  iadtot=iadfin*nnnni*nnnnk
                  if(yw)print*,'iadfin,iadtot',iadfin,iadtot
               endif
            else
c              C...
               if(itj.eq.itk) then
                  if(itk.eq.itl) then
c                    Cooo Cvvv
                     cond='jkl'
c                    j=k=l
                     iad0=nnnnj
                     if(file(1:3).eq.'CDI') then
c                       j=l  k<l
                        iad1=iad0+(nsym*(nsym+1))/2
c                       j=l  k>l
                        iad2=iad1+(nsym*(nsym+1))/2
c                       j<l  k=j
                        iad3=iad2+(nsym*(nsym+1))/2
c                       j<l  k=l
                        iad4=iad3+(nsym*(nsym+1))/2
c                       j<l  k<j
                        iad5=iad4+(nsym*(nsym+1)*(nsym+2))/6
c                       j<l  j<k<l
                        iad6=iad5+(nsym*(nsym+1)*(nsym+2))/6
c                       j<l  k>l
                        iadfin=iad6+(nsym*(nsym+1)*(nsym+2))/6
                     else
                        if(yw)print*,'coucouCDE'
c                       j=l  k<l
                        iad0=(nsym*(nsym+1))/2
c                       j=l  k>l
                        iad1=iad0+(nsym*(nsym+1))/2
c                       j<l  k<j<l
                        iad2=iad1+(nsym*(nsym+1)*(nsym+2))/6
c                       j<l  j<k<l
                        iad3=iad2+(nsym*(nsym+1)*(nsym+2))/6
c                       j>l  j>l>k
                        iad4=iad3+(nsym*(nsym+1)*(nsym+2))/6
                        iadfin=iad4
                     endif
                     iadtot=iadfin*nnnni
                  else
c                    Coov
                     cond='jk'
                     iadfin=nnnnk*nnnnl
                     iadtot=nnnnk*nnnnl*nnnni*nnnnj
                     if(yw)print*,'iadfin',iadfin
                  endif
               else
                  if(itk.eq.itl) then
c                    Covv Cvoo
                     cond='kl'
c                    k=l
                     iad0=nnnnl
c                    k>l
                     iad1=iad0+nnnnk*(nnnnk+1)/2
                     if(ye)iad1=iad0
c                    k<l
                     iadfin=iad1+nnnnk*(nnnnk+1)/2
                     iadtot=iadfin*nnnni*nnnnj
                     if(yw)print*,'iadtot',iadtot
                     call flush(6)
                  else
c                    Covo Cvov
                     cond='jl'
c                    j=l
                     iad0=nnnnl
c                    j>l
                     iad1=iad0+nnnnj*(nnnnj+1)/2
                     if(yi)iad1=iad0
c                    j<l
                     iadfin=iad1+nnnnj*(nnnnj+1)/2
                     iadtot=iadfin*nnnni*nnnnk
                     if(yw)print*,'iadfin',iadfin
                  endif
               endif
            endif
         endif
      else
         if(iti.eq.itj) then
            if(itk.eq.itl) then
               if(itj.eq.itk) then
c                 vvvv oooo
                  cond='ijkl'
                  iadjeqkgtl=nnnni*nnnnj
                  iadjeqkltl=iadjeqkgtl+nnnni*(nnnnk*
     *            (nnnnk-1)/2+nnnnl)
                  iadjgtkeql=iadjeqkltl+nnnni*(nnnnl*
     *            (nnnnl-1)/2+nnnnk)
                  iadjltkeql=iadjgtkeql+
     *            nnnni*(nnnnj*(nnnnj-1)/2*nnnnk)
                  iadjltkltl=iadjltkeql+
     *            nnnni*(nnnnk*(nnnnk-1)/2*nnnnj)
                  iadjgtkltl=iadjltkltl+nnnni*nnnnj*nnnnk*nnnnl/6
                  iadjltkgtl=iadjgtkltl+nnnni*nnnnj*nnnnk*nnnnl/6
                  iadjgtkgtl=iadjltkgtl+nnnni*nnnnj*nnnnk*nnnnl/6
                  iadieqjeqkeql=iadjgtkgtl+nnnni*nnnnj*nnnnk*nnnnl/6
 
               else
c                 oovv
                  cond='ijab'
c                 i=j k=l
                  iad0=nnnni*nnnnl
c                 i=j k>l
                  iad1=iad0+nnnni*nnnnl*(nnnnl+1)/2
c                 i<j k>l
                  iad2=iad1+nnnni*(nnnni+1)*nnnnl*(nnnnl+1)/4
c                 i>j k=l
                  iad3=iad2+nnnni*(nnnni+1)*nnnnl/2
c                 i>j k>l
                  iad4=iad3+nnnni*(nnnni+1)*nnnnl*(nnnnl+1)/4
                  iadtot=iad4
                  if(yw)print*,'iadfin',
     *            iadfin
                  if(yw)print*,'iadtot',iadtot
               endif
            else
c              ooov
               cond='ijk'
            endif
         else
            if(itk.eq.itl) then
c              ovvv
               cond='jkl'
            else
c              ovov
               cond='ovov'
c              i=k j<l
               iad0=nnnni*nnnnl*(nnnnl+1)/2
c              i<k j=l
               iad1=iad0+nnnnj*nnnni*(nnnni+1)/2
c              i<k j<l
               iad2=iad1+nnnni*(nnnni+1)*nnnnl*(nnnnl+1)/4
c              i<k j>l
               iad3=iad2+nnnni*(nnnni+1)*nnnnl*(nnnnl+1)/4
               iadtot=iad3
            endif
         endif
      endif
 
      do k=1,iadtot+1
         nbadsa(k)=0
         mbadsa(k)=0
      enddo
c----------------------------------------------------
c      ouverture de la file d'integrales, lecture
c     comptage du nombre d'integrales de chaque type
c----------------------------------------------------
      open(28,file=file,form='unformatted',status='old')
      do lm=1,llll+1
c        on lit une integrale
         call lirin4(inti,intj,intk,intl,aaint,28)
         lfini=1024
         if(lm.eq.llll+1) lfini=iiii
         do im=1,lfini
c           on calcule iad, adresse de son type
c           nbadsa(iad) est le nb d'int dans ce type
            call disin10(file,in,jn,kn,ln,iad0,iad1,iad2,
     *      iad3,iad4,iad5,iad6,
     *      im,iadsa,cond,
     *      iti,itj,itk,itl,
     *      nnnni,nnnnj,nnnnk,nnnnl,
     *      iadfin,
     *      iad,dum)
            nbadsa(iad)=nbadsa(iad)+1
         enddo
      enddo
      if(yw) then
         if(yw)print*,'iadtot',iadtot
         do k=1,iadtot+1
c            if(yw)print*,'nbadsa',k,nbadsa(k)
            call flush(6)
         enddo
      endif
c     on somme
      do k=2,iadtot
         nbadsa(k)=nbadsa(k)+nbadsa(k-1)
      enddo
      do k=iadtot,1,-1
         nbadsa(k+1)=nbadsa(k)
      enddo
      nbadsa(1)=0
      iadtot=iadtot+1
c      if(yw) then
c         do k=1,iadtot
c            if(yw)print*,'nbadsa',k,nbadsa(k)
c            call flush(6)
c         enddo
c      endif
c-------------------------------------------------------
c     on relit les integrales et on calcule leur adresse
c-------------------------------------------------------
      rewind 28
c      y_en_memoire=(llll*1024+iiii.le.(iadri*4)/3)
      y_en_memoire=(llll*1024+iiii.le.ndr)
      if(y_en_memoire) then
         do lm=1,llll+1
            call lirin4(inti,intj,intk,intl,aaint,28)
            lfini=1024
            if(lm.eq.llll+1) lfini=iiii
            do im=1,lfini
c              on lit une integrale
               call disin10(file,in,jn,kn,ln,iad0,iad1,iad2,
     *         iad3,iad4,iad5,iad6,
     *         im,iadsa,cond,
     *         iti,itj,itk,itl,
     *         nnnni,nnnnj,nnnnk,nnnnl,
     *         iadfin,
     *         iad,aaint(im))
c              iadr est l'adresse de l'integrale
               iadr=nbadsa(iad)+mbadsa(iad)+1
               mbadsa(iad)=mbadsa(iad)+1
               if(yw)print'(a6,4i4,f10.6,5i8)','iadr',inti(im)
     *         ,intj(im),intk(im),intl(im),aaint(im)
     *         ,iadr,iad,nbadsa(iadr),mbadsa(iad)
c               cint(iadr,1)=char(in)
c               cint(iadr,2)=char(jn)
c               cint(iadr,3)=char(kn)
c               cint(iadr,4)=char(ln)
c              on stocke dans cint et b les indices et la valeur
               call encod(in,jn,kn,ln,cint(iadr,1),cint(iadr,2),
     *         cint(iadr,3),cint(iadr,4),cint(iadr,n),4)
c               if(file.eq.'CDI_2233')print'(a3,9i4,i8)','D8'
c     *         ,in,jn,kn,ln,
c     *         (ichar(cint(iadr,kkkk)),kkkk=1,n),(0,kkkk=n+1,5),iadr
               if(yw)print*,'cint',(ichar(cint(iadr,k)),k=1,4)
               b(iadr)=aaint(im)
c              signe
               call disin11(file,in,jn,kn,ln,yhh,iti,itj,itk,itl)
               if(yw)print*,'b(iadr) avant sgn',b(iadr),iadr
               if(yhh) b(iadr)=-b(iadr)
               if(ihab.ne.0) yh(iadr)=yhh
               if(yw)print*,'b(iadr) apres sgn',b(iadr),iadr
               if(yw)print*,'cint',(ichar(cint(iadr,k)),k=1,4)
            enddo
         enddo
      else
         stop'pb mise_en_memoire'
      endif
      k=0
      if(yw1) then
         do i=2,iadtot
            longl=nbadsa(i)-nbadsa(i-1)
            if(longl.ne.0) print*,'debut liste',longl,nbadsa(i)
            do j=1,nbadsa(i)-nbadsa(i-1)
               k=k+1
               print'(a4,i5,2x,4i4,f12.8)',
     *         'INT',k,ichar(cint(k,1)),ichar(cint(k,2)),
     *         ichar(cint(k,3)),ichar(cint(k,4)),b(k)
            enddo
         enddo
      endif
c
c----------------------------------------------------------
c     on efface la file d'int particulieres
c     on va la recreer sous le meme nom, avec les memes int
c     dans un autre ordre, celui des adresses
c----------------------------------------------------------
c
      rewind 28
      close(28,status='delete')
      open(28,file=file,form='unformatted',status='unknown')
      if(ihab.ne.0)
     *open(53,status='unknown',form='unformatted',file='H'//file(2:8))
      lbid=0
      ibid=0
      do k=1,llll*1024+iiii
         call decod1(cint(k,n),cint(k,1),cint(k,2)
     *   ,cint(k,3),cint(k,4),i1,j1,k1,l1,n)
         call disin1(lbid,ibid,28,i1,j1,k1,l1,
     *   b(k),1)
      enddo
      call disin2(1,28)
      if(ihab.ne.0) then
         do ii=1,llll*1024+iiii,1024
            call ecry(yh(ii),1024,53)
         enddo
      endif
c      if(file.eq.'CDE_2323')close(28,status='delete')
      close(28)
      close(53)
c     on ouvre une file contenant commen info le nb d'int
c     de chaque type
      if(yw)print*,'ouverture ',file//'L'
      open(28,file=file//'L',form='unformatted',status='unknown')
      iad5=0
      do k=1,iadtot
         if(mbadsa(k).ne.0) then
            iad5=iad5+1
            mbadsa(iad5)=mbadsa(k)
         endif
      enddo
      write(28) iad5,(mbadsa(k),k=1,iad5)
      close(28)
      if(yw)print*,'iad5,mbadsa',iad5,(mbadsa(k),k=1,iad5)
      if(yw)print*,'fin disin8'
      call flush(6)
      return
      end
 
 
 
 
 
 
 
 
       subroutine disin10(file,in,jn,kn,ln,iad0,iad1,iad2,
     *iad3,iad4,iad5,iad6,
     *im,iadsa,cond,
     *iti,itj,itk,itl,
     *nnnni,nnnnj,nnnnk,nnnnl,
     *iadfin,
     *iad,aa)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      dimension iadsa(maxorb)
      character*5 cond
      character*8 file
      yw=.false.
      in=inti(im)
      jn=intj(im)
      kn=intk(im)
      ln=intl(im)
      yord=.false.
      if(file(3:3).eq.'I') then
         if(iti.eq.itk) then
            in=min(inti(im),intk(im))
            kn=max(inti(im),intk(im))
         endif
         if(itj.eq.itl) then
            jn=min(intj(im),intl(im))
            ln=max(intj(im),intl(im))
         endif
      endif
      if(file(3:3).eq.'E') then
         if(iti.eq.itk) then
            if(itj.eq.itl) then
               if(in.gt.kn) then
                  in1=in
                  in=kn
                  kn=in1
                  jn1=jn
                  jn=ln
                  ln=jn1
               endif
            endif
         endif
         if(itk.eq.itl) then
            if(kn.gt.ln) then
               iii=kn
               kn=ln
               ln=iii
               aa=-aa
            endif
         endif
         if(iti.eq.itj) then
            if(in.gt.jn) then
               iii=in
               in=jn
               jn=iii
               aa=-aa
            endif
         endif
         if(file.eq.'CDE_2111') then
            if(jn.eq.kn) then
               iii=kn
               kn=ln
               ln=iii
               aa=-aa
            endif
         endif
      endif
      iain=iadsa(in)
      iajn=iadsa(jn)
      iakn=iadsa(kn)
      ialn=iadsa(ln)
      if(yw)print*,'entree disin10  cond,int :   ',cond,in,jn,kn,ln
      if(yw)print*,'iain,iajn,iakn,ialn',iain,iajn,iakn,ialn
      if(cond.eq.'0') then
         iadij=iain+(iajn-1)*nnnni
         iadkl=iakn+(ialn-1)*nnnnk
         iad=iadkl+(iadij-1)*iadfin
      else if(cond.eq.'CoCv') then
         iadik=iain+(iakn-1)*nnnni
         iadjl=iajn+(ialn-1)*nnnnj
         iad=iadjl+(iadik-1)*iadfin
      else if(cond.eq.'CCC') then
         iadl=ialn
         iadijk=iakn+(iajn-1)*nnnnk+(iain-1)*nnnnk*nnnnj
         iad=iadl+(iadijk-1)*iadfin
      else if(cond.eq.'jl') then
         iadik=iain+(iakn-1)*nnnni
         if(jn.eq.ln) then
            iadjl=ialn
            if(yw)print*,'0     ',in,jn,kn,ln,iadkl
         else if(jn.lt.ln) then
            iadjl=iad0+ialn*(ialn-1)/2+iajn
            if(yw)print*,'1     ',in,jn,kn,ln,iadjl
         else if(jn.gt.ln) then
            iadjl=iad1+iajn*(iajn-1)/2+ialn
            if(yw)print*,'1     ',in,jn,kn,ln,iadjl
         endif
         iad=iadjl+(iadik-1)*iadfin
      else if(cond.eq.'kl') then
         iadij=iain+(iajn-1)*nnnni
         if(kn.eq.ln) then
            iadkl=ialn
            if(yw)print*,'0     ',in,jn,kn,ln,iadkl
         else if(kn.gt.ln) then
            iadkl=iad0+iakn*(iakn-1)/2+ialn
            if(yw)print*,'1     ',in,jn,kn,ln,iadkl
         else if(kn.lt.ln) then
            iadkl=iad1+ialn*(ialn-1)/2+iakn
            if(yw)print*,'2     ',in,jn,kn,ln,iadkl
         endif
         if(yw)print*,'iadkl,iadij,iadfin',iadkl,iadij,iadfin
         iad=iadkl+(iadij-1)*iadfin
      else if(cond.eq.'jkl') then
         if(yw)print*,'coucou3'
         if(file(3:3).eq.'I') then
         if(yw)print*,'coucou4'
            if(jn.eq.ln) then
               if(jn.eq.kn) then
                  iadjkl=iajn
                  if(yw)print*,'0     ',in,jn,kn,ln,iadjkl
               else if(kn.lt.ln) then
                  iadjkl=iad0+(iajn)*(iajn-1)/2+iakn
                  if(yw)print*,'1     ',in,jn,kn,ln,iadjkl
               else if(kn.gt.ln) then
                  iadjkl=iad1+(iakn)*(iakn-1)/2+iajn
                  if(yw)print*,'2     ',in,jn,kn,ln,iadjkl
               endif
            else if(jn.lt.ln) then
               if(kn.eq.jn) then
                  iadjkl=iad2+(ialn)*(ialn-1)/2+iakn
                  if(yw)print*,'3     ',in,jn,kn,ln,iadjkl
               else if(kn.eq.ln) then
                  iadjkl=iad3+(ialn)*(ialn-1)/2+iajn
               else if(kn.lt.jn) then
                  iadjkl=iad4+(ialn-2)*(ialn-1)*(ialn)/6+
     *            (iajn)*(iajn-1)/2+iakn
                  if(yw)print*,'4     ',in,jn,kn,ln,iadjkl
               else if(jn.lt.kn.and.kn.lt.ln) then
                  iadjkl=iad5+(ialn-2)*(ialn-1)*(ialn)/6+
     *            (iakn)*(iakn-1)/2+iajn
               else if(kn.gt.ln) then
                  iadjkl=iad6+(iakn-2)*(iakn-1)*(iakn)/6+
     *            (ialn)*(ialn-1)/2+iajn
               endif
            endif
         else
         if(yw)print*,'coucou5'
            if(jn.eq.ln) then
               if(kn.lt.ln) then
                  iadjkl=(ialn)*(ialn-1)/2+iakn
                  if(yw)print*,'0     ',in,jn,kn,ln,iadjkl
               else if(kn.gt.ln) then
                  iadjkl=iad0+(iakn)*(iakn-1)/2+ialn
                  if(yw)print*,'5     ',in,jn,kn,ln,iadjkl
               endif
            else if(jn.lt.ln) then
               if(kn.lt.jn) then
                  iadjkl=iad1+(ialn-2)*(ialn-1)*(ialn)/6+
     *            (iajn)*(iajn-1)/2+iakn
                  if(yw)print*,'2     ',in,jn,kn,ln,iadjkl
               else if(kn.gt.jn) then
                  iadjkl=iad2+(ialn-2)*(ialn-1)*(ialn)/6+
     *            (iakn)*(iakn-1)/2+iajn
                  if(yw)print*,'3     ',in,jn,kn,ln,iadjkl
               endif
            else if(jn.gt.ln) then
               iadjkl=iad3+(iajn-2)*(iajn-1)*(iajn)/6+
     *         (ialn)*(ialn-1)/2+iakn
                  if(yw)print*,'4     ',in,jn,kn,ln,iadjkl,iad3
            endif
         endif
         if(yw)print*,'iain,iadjkl,nnnni',iain,iadjkl,nnnni
         iad=iain+(iadjkl-1)*nnnni
      else if(cond.eq.'ijab') then
         if(in.eq.jn) then
            if(kn.eq.ln) then
               iad=iain+(iakn-1)*nnnni
            else if(kn.gt.ln) then
               iad=iad0+iain+((iakn)*(iakn-1)/2+ialn-1)*nnnni
            endif
         else if(in.lt.jn) then
            iad=iad1+(iakn)*(iakn-1)/2+ialn+((iajn)
     *      *(iajn-1)/2+iain-1)*
     *      nnnnk*(nnnnk+1)/2
         else if(in.gt.jn) then
            if(kn.eq.ln) then
               iad=iad2+iakn+((iain)*(iain-1)/2+iajn-1)*nnnnk
            else if(kn.gt.ln) then
               iad=iad3+iakn*(iakn-1)/2+ialn+((iain)
     *         *(iain-1)/2+iajn-1)*
     *         nnnnk*(nnnnk+1)/2
            endif
         endif
      else if(cond.eq.'ovov') then
         if(in.eq.kn) then
            iad=ialn*(ialn-1)/2+iajn+(iain-1)*nnnnl*(nnnnl+1)/2
         else if(in.lt.kn) then
            if(jn.eq.ln) then
               iad=iad0+iakn*(iakn-1)/2+iain+(iajn-1)*nnnnk*(nnnnk+1)/2
            else if(jn.lt.ln) then
               iad=iad1+iakn*(iakn-1)/2+iain
     *         +(ialn*(ialn-1)/2+iajn-1)*nnnnk*(nnnnk+1)/2
            else if(jn.gt.ln) then
               iad=iad2+iakn*(iakn-1)/2+iain
     *         +(iajn*(iajn-1)/2+ialn-1)*nnnnk*(nnnnk+1)/2
            endif
         endif
      endif
      if(yw)print*,'sortie disin10  iad',iad
      return
      end
       subroutine disin11(file,i,j,k,l,yhh,iti,itj,itk,itl)
c------------------------------------------------------------
c     signe des integrales
c------------------------------------------------------------
      parameter(maxsym=8,maxorbcas=16,maxda3=300)
      include 'maxorb.prm'
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      common/sy3/itorbi(maxorb),isbrot(maxorb),itorbc(maxorb)
     *,itorbs(maxorb)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      character*8 file
      dimension isgna0(maxorb),isgnb0(maxorb)
      yw=.false.
c----------------------------------------------
c           signe pour les integrales directes
c----------------------------------------------
c--            changement de signe pour les int <ijil>
c              si i est inactive
      yhh1=.false.
      isgno=1
      ii=itorbc(i)
      jj=itorbc(j)
      kk=itorbc(k)
      ll=itorbc(l)
      if(iti.ne.1) ii=ninac+1
      if(itj.ne.1) jj=ninac+1
      if(itk.ne.1) kk=ninac+1
      if(itl.ne.1) ll=ninac+1
      if(yw)print'(a10,3(4i3,2x))','i,j,k,l',i,j,k,l,ii,jj,kk,ll
      if(yw)print'(a10,3(4i3,2x))','iti,itj,itk,itl',iti,itj,itk,itl
      isg=0
      if(index(file,'2').ne.0) then
!         if(iti.eq.1) isg=isg-ii+ninac
!         if(yw)print*,'1isg',isg
!         if(itk.eq.1) isg=isg-kk+ninac
!         if(yw)print*,'2isg',isg
!         if(iti.eq.1.and.itk.eq.1.and.ii.ne.kk) isg=isg+1
!         if(yw)print*,'3isg',isg
!         if(itj.eq.1) isg=isg-jj+ninac
!         if(yw)print*,'4isg',isg
!         if(itl.eq.1) isg=isg-ll+ninac
!         if(yw)print*,'5isg',isg
!         if(itj.eq.1.and.itl.eq.1.and.jj.ne.ll) isg=isg+1
         im=min(ii,kk)
         jm=min(jj,ll)
         km=max(ii,kk)
         lm=max(jj,ll)
         do kkk=1,ninac
            isgna0(kkk)=1
            isgnb0(kkk)=1
         enddo
        if(yw)print*,'1isgna0',(isgna0(kkk),kkk=1,ninac)
        if(yw)print*,'1isgnb0',(isgnb0(kkk),kkk=1,ninac)
         do kkk=im+1,km-1
            isgna0(kkk)=-isgna0(kkk)
         enddo
        if(yw)print*,'2isgna0',(isgna0(kkk),kkk=1,ninac)
        if(yw)print*,'2isgnb0',(isgnb0(kkk),kkk=1,ninac)
         if(file(3:3).eq.'I') then
            do kkk=jm+1,lm-1
               isgnb0(kkk)=-isgnb0(kkk)
            enddo
         else
            do kkk=jm+1,lm-1
               isgna0(kkk)=-isgna0(kkk)
            enddo
         endif
        if(yw)print*,'3isgna0',(isgna0(kkk),kkk=1,ninac)
        if(yw)print*,'3isgnb0',(isgnb0(kkk),kkk=1,ninac)
         isgna0(ii)=1
         isgna0(kk)=1
         if(file(3:3).eq.'I') then
            isgnb0(jj)=1
            isgnb0(ll)=1
         else
            isgna0(jj)=1
            isgna0(ll)=1
         endif
        isgno=1
        do kkk=1,ninac
           isgno=isgno*isgna0(kkk)*isgnb0(kkk)
        enddo
        yhh1=isgno.eq.-1
        if(yw)print*,'isgna0',(isgna0(kkk),kkk=1,ninac)
        if(yw)print*,'isgnb0',(isgnb0(kkk),kkk=1,ninac)
        if(yw)print *,'isgno',isgno
 
 
      endif
!      if(yw)print*,'6isg',isg
!      yhh1=mod(isg,2).ne.0
      if(yw)print'('' yhh1 '',2l2)',yhh1
      if(yw)print'(a6,5i3,f12.8,a9)','jsgno'
     *,i,j,k,l,file
c----------------------------
c     integrales ijik ou ijkj
c----------------------------
      if(file.eq.'CDI_1212'.or.file.eq.'CDI_2131') then
         if(j.eq.l) then
            yhh1=.not.yhh1
         endif
      endif
      if(file.eq.'CDI_2111') then
         if(j.eq.l) then
            yhh1=.not.yhh1
         endif
      endif
c---------------------------------------------------
c     signe pour les integrales directes + echange
c---------------------------------------------------
      if(file(3:3).eq.'E') then
c--      changement de signe pour les int <ijil> si i est
c        entre j et l
c       if(yw)print*,'isbrot a',a,i,j,k,l
         if(i.eq.k.and.
     *   (isbrot(l)-isbrot(i))*(isbrot(j)-isbrot(i)).lt.0) then
            yhh1=.not.yhh1
            if(yw)print'('' 1 yhh1'',l2)',yhh1
         endif
         if(j.eq.l.and.
     *   (isbrot(k)-isbrot(j))*(isbrot(i)-isbrot(j)).lt.0) then
            yhh1=.not.yhh1
            if(yw)print'('' 2 yhh1'',l2)',yhh1
         endif
         if(j.eq.k.and.
     *   (isbrot(l)-isbrot(j))*(isbrot(i)-isbrot(j)).lt.0) then
            yhh1=.not.yhh1
            if(yw)print'('' 3 yhh1'',l2)',yhh1
         endif
         if(i.eq.l.and.
     *   (isbrot(k)-isbrot(i))*(isbrot(j)-isbrot(i)).lt.0) then
            yhh1=.not.yhh1
            if(yw)print'('' 4 yhh1'',l2)',yhh1
         endif
         if(yw)print*,
     *   'isbrot ',isbrot(i),isbrot(j),isbrot(k),
     *   isbrot(l)
c        si on a 2 indices d'inactives ensemble, signe -
c        en effet, l'indice de gauche saute l'indice de droite...
c        deja absent
!         if(iti.eq.1.and.itj.eq.1) then
!            if(itk.ne.1.or.k.gt.max(i,j)) then
!               if(itl.ne.1.or.l.gt.max(i,j)) yhh1=.not.yhh1
!            endif
!            print'('' 5 yhh1'',l2)',yhh1
!         endif
!         if(itk.eq.1.and.itl.eq.1) then
!            if(iti.ne.1.or.i.gt.max(k,l)) then
!               if(itj.ne.1.or.j.gt.max(k,l)) yhh1=.not.yhh1
!            endif
!            print'('' 6 yhh1'',l2)',yhh1
!         endif
      endif
      yhh=yhh1
      return
      end
