      subroutine disin5(aa,coef,y,yh)
c
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    |      aa       |y| coef  | |   |
c                               yh
c
c
c-------------------------------------------------------------
c     en fonctionnement normal (cad quand on ne teste pas le pgm)
c     disin5 n'est pas appelee, car on sort de disin51 des que h66
c     est T.
c     y66 est mis a T dans disin9 (appelee par disin8). C'est si
c     on supprime quelques appels que disin5 se met a tourner
c     a terme, il faudra supprimer disin5
c-------------------------------------------------------------
c
      parameter(maxsym=8,maxorbcas=16,maxda3=300)
      include 'maxorb.prm'
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common/dim/iadri ; integer(8) iadri
      common /prep2/ icatt(2,maxsym,maxsym,-1:1),
     *icatp(2,maxsym,maxsym,-1:1)
     *,itorb(maxorb*2),icatc(maxsym,maxsym,0:maxorbcas,0:maxorbcas)
      character*4 hab
      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
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      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
      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
      common/test/itest(100)
      common/ad2111/ id2111(maxorb)
      dimension aa(iadri)
      character*1 coef(iadri,4)
      dimension y(iadri),yh(iadri)
      common/sy2/nts(maxsym),ncs(maxsym),nps(maxsym)
     *,norbs(maxsym)
      common/pr/nprint,mprint(10)
      common/c66/ y66(3,3,3,3),ye66(3,3,3,3)
      yw=nprint.ge.3
      yw1=nprint.ge.2
c      print*,'entree disin5 irest',irest
      if(ygcas) return
      if(irest.eq.1.or.irest.eq.2) return
c--   preparation pour l'adressage de CDI_2111
      id2111(2)=0
      do k=3,ninac+1
         id2111(k)=id2111(k-1)+(k-2)*(k-3)
      enddo
c
c--------------------------------------------------------------
c     reordonnancement des integrales CCvv CvCv ooCC oCoC
c     Coo CoCv
c--------------------------------------------------------------
c
      if(itest(38).eq.1) then
         call disin51('CDI_2233',l2233,i2233
     *   ,ncs,ncs,nps,nps,2,2,3,3,aa,coef,y,yh,9,y66(2,2,3,3))
         call disin51('CDE_2233',le2233,ie2233
     *   ,ncs,ncs,nps,nps,2,2,3,3,aa,coef,y,yh,10,ye66(2,2,3,3))
         call disin51('CDI_2323',l2323,i2323
     *   ,ncs,ncs,nps,nps,2,2,3,3,aa,coef,y,yh,11,y66(2,3,2,3))
         call disin51('CDE_2323',le2323,ie2323
     *   ,ncs,ncs,nps,nps,2,2,3,3,aa,coef,y,yh,12,ye66(2,3,2,3))
      endif
      if(itest(39).eq.1) then
         call disin51('CDI_1122',l1122,i1122
     *   ,ncs,ncs,nts,nts,2,2,1,1,aa,coef,y,yh,9,y66(2,2,1,1))
         call disin51('CDE_1122',le1122,ie1122
     *   ,ncs,ncs,nts,nts,2,2,1,1,aa,coef,y,yh,10,ye66(2,2,1,1))
         call disin51('CDI_1212',l1212,i1212
     *   ,ncs,ncs,nts,nts,2,2,1,1,aa,coef,y,yh,11,y66(2,1,2,1))
         call disin51('CDE_1212',le1212,ie1212
     *   ,ncs,ncs,nts,nts,2,2,1,1,aa,coef,y,yh,12,ye66(2,1,2,1))
      endif
      if(itest(40).eq.1) then
         call disin51('CDI_2133',l2133,i2133
     *   ,ncs,nts,nps,nps,2,1,3,3,aa,coef,y,yh,9,y66(2,1,3,3))
         call disin51('CDE_2133',le2133,ie2133
     *   ,ncs,nts,nps,nps,2,1,3,3,aa,coef,y,yh,10,ye66(2,1,3,3))
         call disin51('CDI_2313',l2313,i2313
     *   ,ncs,nts,nps,nps,2,1,3,3,aa,coef,y,yh,11,y66(2,3,1,3))
         call disin51('CDE_2313',le2313,ie2313
     *   ,ncs,nts,nps,nps,2,1,3,3,aa,coef,y,yh,12,ye66(2,3,1,3))
      endif
      if(itest(41).eq.1) then
         call disin51('CDI_2311',l2311,i2311
     *   ,ncs,nps,nts,nts,2,3,1,1,aa,coef,y,yh,9,y66(2,3,1,1))
         call disin51('CDE_2311',le2311,ie2311
     *   ,ncs,nps,nts,nts,2,3,1,1,aa,coef,y,yh,10,ye66(2,3,1,1))
         call disin51('CDI_2131',l2131,i2131
     *   ,ncs,nps,nts,nts,2,3,1,1,aa,coef,y,yh,11,y66(2,1,3,1))
         call disin51('CDE_2131',le2131,ie2131
     *   ,ncs,nps,nts,nts,2,3,1,1,aa,coef,y,yh,12,ye66(2,1,3,1))
      endif
      if(itest(42).eq.1) then
         call disin52('CDI_2111',l2111,i2111
     *   ,ncs,nts,nts,nts,aa,coef,y,yh,y66(2,1,1,1))
         call disin52('CDI_2111',l2111,i2111
     *   ,ncs,nts,nts,nts,aa,coef,y,yh,y66(2,1,1,1))
         call disin52('CDI_2111',l2111,i2111
     *   ,ncs,nts,nts,nts,aa,coef,y,yh,y66(2,1,1,1))
c         call delfil('CDI_2111')
         call disin52('CDE_2111',le2111,ie2111
     *   ,ncs,nts,nts,nts,aa,coef,y,yh,ye66(2,1,1,1))
      endif
      if(itest(43).eq.1) then
         call disin51('CDI_2213',l2213,i2213
     *   ,ncs,ncs,nts,nps,2,2,1,3,aa,coef,y,yh,9,y66(2,2,1,3))
         call disin51('CDE_2213',le2213,ie2213
     *   ,ncs,ncs,nts,nps,2,2,1,3,aa,coef,y,yh,10,ye66(2,2,1,3))
         call disin51('CDI_2123',l2123,i2123
     *   ,ncs,ncs,nts,nps,2,2,1,3,aa,coef,y,yh,11,y66(2,1,2,3))
         call disin51('CDE_2123',le2123,ie2123
     *   ,ncs,ncs,nts,nps,2,2,1,3,aa,coef,y,yh,12,ye66(2,1,2,3))
      endif
      return
      end
       subroutine disin51(file,llll,iiii,ns1,ns2,ns3,ns4,
     *it1,it2,it3,it4,aa,coef,y,yh,icas,y66)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      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
      dimension iadrs(maxsym,maxsym,maxsym+4)
      dimension ns1(maxsym),ns2(maxsym),ns3(maxsym),ns4(maxsym)
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      common/sy7/inumsy(maxsym,maxorb)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sy3/itorbi(maxorb),isbrot(maxorb),itorbc(maxorb)
     *,itorbs(maxorb)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/sy4/ntstot(0:maxsym),ncstot(0:maxsym),npstot(0:maxsym)
      common /nummrs/nummr(maxorb)
      character*8 file
      dimension aa(iadri)
      common/test/itest(100)
      character*1 coef(iadri,4),coe
      dimension y(iadri),yh(iadri)
      dimension isgna0(maxorb),isgnb0(maxorb)
      common/ad2111/ id2111(maxorb)
      common/opt/ihab,calcul
      character*3 calcul
      common/pr/nprint,mprint(10)
      yw=nprint.ge.3
      yw1=nprint.ge.2
      if(y66) return
      yi2233=file.eq.'CDI_2233'.or.file.eq.'CDI_1122'
      ye2233=file.eq.'CDE_2233'.or.file.eq.'CDE_1122'
      yi2323=file.eq.'CDI_2323'.or.file.eq.'CDI_1212'
      ye2323=file.eq.'CDE_2323'.or.file.eq.'CDE_1212'
      yi2133=file.eq.'CDI_2133'.or.file.eq.'CDI_2311'
      ye2133=file.eq.'CDE_2133'.or.file.eq.'CDE_2311'
      yi2313=file.eq.'CDI_2313'.or.file.eq.'CDI_2131'
      ye2313=file.eq.'CDE_2313'.or.file.eq.'CDE_2131'
      ye2111=file.eq.'CDE_2111'
      yi2213=file.eq.'CDI_2213'
      ye2213=file.eq.'CDE_2213'
      yi2123=file.eq.'CDI_2123'
      ye2123=file.eq.'CDE_2123'
      iii=0
c=========================================================
c     classes d'equivalence  iadrs(is,js,ks)
c     iadrs est le point de depart de la classe d'equivalence
c=========================================================
c
c
      if(yw)print*,'file,icas',file,icas
c     symetries differentes
      do is=1,nsym
         if(it1.eq.it2.and..not.(yi2213.or.ye2123)) then
            idebj=is+1
         else
            idebj=1
         endif
         do js=idebj,nsym
            if(js.eq.is) goto 21
            ijs=its(is,js)
            do ks=1,nsym
               ls=its(ijs,ks)
               if((ye2233.or.yi2323.or.ye2133.or.yi2313.or.ye2111)
     *         .and.ls.lt.ks) goto 2
               iadrs(is,js,ks)=iii
               if(yw) then
                  write(75,*)'0 is,js,ks,iadrs',is,js,ks,iadrs
     *            (is,js,ks),ns1(is),ns2(js),ns3(ks),ns4(ls),'$'
                  call scril
               endif
               iii=iii+ns1(is)*ns2(js)*ns3(ks)*ns4(ls)
 2             continue
            enddo
 21         continue
         enddo
      enddo
c     symetries egales, aucune orbitale egale
      do is=1,nsym
         do ks=1,nsym
            iadrs(is,ks,maxsym+1)=iii
            if(yw) then
               write(75,*)'1 is,ks,9,iadrs',is,ks,9,iadrs
     *         (is,ks,maxsym+1),'$'
               call scril
            endif
            if(yi2233.or.ye2323) then
               iii=iii+(ns1(is)*(ns1(is)-1)/2)*ns3(ks)*(ns3(ks)-1)
            else if(ye2233.or.yi2323) then
               iii=iii+(ns1(is))*(ns1(is)-1)*
     *         (ns3(ks))*(ns3(ks)-1)/4
            else if(yi2133.or.ye2313) then
               iii=iii+ns1(is)*ns2(is)*
     *         (ns3(ks)*(ns3(ks)-1))
            else if(ye2133.or.yi2313) then
               iii=iii+ns1(is)*ns2(is)*
     *         (ns3(ks))*(ns3(ks)-1)/2
            else if(ye2111) then
               iii=iii+ns1(is)*ns2(is)*ns3(ks)*(ns3(ks)-1)/2
 6             continue
            else if(yi2213.or.ye2123) then
               iii=iii+ns1(is)*(ns1(is))*
     *         (ns3(ks)*ns4(ks))
            else if(yi2123) then
               iii=iii+ns1(is)*(ns1(is)+1)/2*
     *         (ns3(ks)*ns4(ks))
               if(yw)
     *         print*,'is,ns1(is),iii',is,ns1(is),iii,ns3(ks),ns4(ks)
            else if(ye2213) then
               iii=iii+ns1(is)*(ns1(is)-1)/2*
     *         (ns3(ks)*ns4(ks))
               if(yw)
     *         print*,'is,ns1(is),iii',is,ns1(is),iii,ns3(ks),ns4(ks)
            endif
         enddo
      enddo
      if(ye2233.or.ye2133.or.ye2111.or.yi2213.or.ye2213
     *.or.yi2123.or.ye2123) goto 3
      if(it1.ne.it2) goto 4
c     symetries egales, i=j
      do is=1,nsym
         do ks=1,nsym
            iadrs(is,ks,maxsym+2)=iii
            if(yw) then
               write(75,*)'2 is,ks,10,iadrs',is,ks,10,iadrs
     *         (is,ks,maxsym+2),'$'
               call scril
            endif
            iii=iii+ns1(is)*(ns3(ks)-1)*ns3(ks)/2
         enddo
      enddo
 4    continue
c     symetries egales, k=l
      if(it3.ne.it4) goto 3
      if(yw)print*,'cas k=l'
      do is=1,nsym
         do ks=1,nsym
            iadrs(is,ks,maxsym+3)=iii
            if(yw) then
               write(75,*)'3 is,ks,11,iadrs',is,ks,11,iadrs
     *         (is,ks,maxsym+3),'$'
               call scril
            endif
            if(it1.eq.it2) then
               iii=iii+(ns1(is)*(ns1(is)-1)/2)*ns3(ks)
            else
               iii=iii+ns1(is)*ns2(is)*ns3(ks)
            endif
         enddo
      enddo
      if(yi2323.or.ye2323) goto 3
      if(it1.ne.it2.or.it3.ne.it4) goto 3
c     symetries egales, i=j, k=l
      do is=1,nsym
         do ks=1,nsym
            iadrs(is,ks,maxsym+4)=iii
            if(yw) then
               write(75,*)'4 is,ks,12,iadrs',is,ks,12,iadrs
     *         (is,ks,maxsym+4),'$'
               call scril
            endif
            iii=iii+ns1(is)*ns3(ks)
         enddo
      enddo
 3    continue
      if(yw)print*,'dimension max ',file,iii
      call flush(6)
c=========================================================
c     lecture et mise en memoire des integrales
c     classement en fonction de leur adresse
c=========================================================
      do k=1,iii
         y(k)=.false.
         yh(k)=.false.
         aa(k)=0.d0
      enddo
      open(29,status='old',form='unformatted',file=file)
      if(ihab.ne.0)
     *open(53,status='unknown',form='unformatted',file='H'//file(2:8))
      if(yw)print*,'llll,iiii',llll,iiii,llll*1024+iiii
      do ln=1,llll+1
         call lirin4(inti,intj,intk,intl,aaint,29)
         lfini=1024
         if(ln.eq.llll+1)lfini=iiii
         do in=1,lfini
            i=inti(in)
            jv=intj(in)
            kv=intk(in)
            if(icas.le.10) then
               j=intj(in)
               k=intk(in)
            else
               k=intj(in)
               j=intk(in)
            endif
            l=intl(in)
            a=aaint(in)
            aaaaa=a
            yhh=.false.
 9          continue
            if(yw)print'(a20,4i3,f12.8)','apres lect i,j,k,l',i,j,k,l,a
c
c           signe pour les integrales directes
c
c--            changement de signe pour les int <ijil>
c              si i est inactive
            if(file.eq.'CDI_1212'.or.file.eq.'CDI_2131') then
               if(k.eq.l) then
                  a=-a
                  yhh=.not.yhh
c                  print*,'1aaaaa',a,aaaaa,yhh
               endif
            endif
            if(file.eq.'CDI_2111') then
               if(icas.eq.8) then
                  if(j.gt.l.and.k.ne.l) goto 10
               else if(icas.eq.9) then
                  if(j.lt.l) goto 10
                  if(k.eq.l) goto 10
               endif
               if(j.eq.l) then
                  a=-a
                  yhh=.not.yhh
               endif
            endif
            isgno=1
            ii=itorbc(i)
            jj=itorbc(jv)
            kk=itorbc(kv)
            ll=itorbc(l)
            im=min(ii,kk)
            jm=min(jj,ll)
            km=max(ii,kk)
            lm=max(jj,ll)
            if(yw)print'(a10,3(4i3,2x))','i,j,k,l',i,j,k,l,ii,jj,kk,ll,
     *      i,jv,kv,l
            do kkk=1,ninac
               isgna0(kkk)=1
               isgnb0(kkk)=1
            enddo
            if(itype(jv).eq.1) then
               if(itype(l).eq.1) then
                  jjj=min(jj,ll)
                  lll=max(jj,ll)
                  if(file(3:3).eq.'I') then
                     do kkk=jjj+1,lll-1
                        isgnb0(kkk)=-isgnb0(kkk)
                     enddo
                  else
                     do kkk=jjj+1,lll-1
                        isgna0(kkk)=-isgna0(kkk)
                     enddo
                  endif
               else
                  if(file(3:3).eq.'I') then
                     do kkk=jj+1,ninac
                        isgnb0(kkk)=-isgnb0(kkk)
                     enddo
                  else
                     do kkk=jj+1,ninac
                        isgna0(kkk)=-isgna0(kkk)
                     enddo
                  endif
               endif
            endif
            if(itype(kv).eq.1) then
               do kkk=kk+1,ninac
                  isgna0(kkk)=-isgna0(kkk)
               enddo
            endif
            if(itype(l).eq.1.and.itype(jv).ne.1) then
               if(file(3:3).eq.'I') then
                  do kkk=ll+1,ninac
                     isgnb0(kkk)=-isgnb0(kkk)
                  enddo
               else
                  do kkk=ll+1,ninac
                     isgna0(kkk)=-isgna0(kkk)
                  enddo
               endif
            endif
 
            if(yw)print'(a7,10i3)','isgna0',(isgna0(kkk),kkk=1,ninac)
            if(yw)print'(a7,10i3)','isgnb0',(isgnb0(kkk),kkk=1,ninac)
            if(itype(jv).eq.1) then
               if(file(3:3).eq.'I') then
                  isgnb0(jj)=1
               else
                  isgna0(jj)=1
               endif
            endif
            if(itype(kv).eq.1) then
               isgna0(kk)=1
            endif
            if(itype(l).eq.1) then
               if(file(3:3).eq.'I') then
                  isgnb0(ll)=1
               else
                  isgna0(ll)=1
               endif
            endif
c            if(yw)print'(a7,10i3)','isgna0',(isgna0(kkk),kkk=1,ninac)
c            if(yw)print'(a7,10i3)','isgnb0',(isgnb0(kkk),kkk=1,ninac)
            isgno=1
            do kkk=1,ninac
               isgno=isgno*isgna0(kkk)*isgnb0(kkk)
            enddo
            a=a*isgno
            if(isgno.eq.-1) yhh=.not.yhh
c               if(yw)print'(a6,5i3,f12.8,a9)','isgno'
c     *         ,i,jv,kv,l,isgno,a,file
 
c
c     signe pour les integrales directes + echange
c
c--         changement de signe pour les int <ijil> si i est
c           entre j et l
c            if(file.eq.'CDE_1212'.or.file.eq.'CDE_2131'
c     *      .or.file.eq.'CDE_1212'.or.file.eq.'CDE_2111') then
            if(file(3:3).eq.'E') then
c               if(yw)print*,'isbrot a',a,i,jv,kv,l
               if(i.eq.kv.and.
     *         (isbrot(l)-isbrot(i))*(isbrot(jv)-isbrot(i)).lt.0) then
                  a=-a
                  yhh=.not.yhh
               endif
               if(jv.eq.l.and.
     *         (isbrot(kv)-isbrot(jv))*(isbrot(i)-isbrot(jv)).lt.0) then
                  a=-a
                  yhh=.not.yhh
               endif
               if(yw)print*,
     *         'isbrot a',a,isbrot(i),isbrot(jv),isbrot(kv),
     *         isbrot(l)
            endif
c            write(75,*)'disin5 int CDI_2233',
c     *      (ln-1)*1024+in,i,j,k,l,a,'$'
c            call scril
            call disadr5(i,j,k,l,ii,jj,kk,ll,
     *      iadr,iadrs,ns1,ns2,ns3,ns4,file,isgn,icas)
            if(yw) then
c               if(itsym(i).eq.3.and.itsym(j).eq.2.and.itsym(k).eq.4)
c     *         print'(a10,4i4,f10.6)','S1111',i,j,k,l,a
               write(75,*)'i,j,k,l,iadr,a,isgn',(ln-1)*1024+in,' / ',
     *         i,j,k,l,iadr,a,isgn,'$'
               call scril
            endif
            if(y(iadr)) then
               print*,'disin51 deja vu',iadr
               stop
            endif
            if(iadr.gt.iii.or.iadr.le.0) then
               print*,'disin5 adresse mauvaise',iadr,iii
               stop
            endif
c
c           disadr5     a reordonne les indices
c           il ne faut pas avoir ijjk ou ijki dans les int dir + ech
c
            if(file(3:3).eq.'E') then
               if(icas.le.10) then
                  if(ii.eq.ll) then
                     ijk=ll
                     ll=kk
                     kk=ijk
                     isgn=-isgn
                  endif
                  if(jj.eq.kk) then
                     ijk=ll
                     ll=kk
                     kk=ijk
                     isgn=-isgn
                  endif
               else
                  if(ii.eq.ll) then
                     ijk=ll
                     ll=jj
                     jj=ijk
                     isgn=-isgn
                  endif
                  if(jj.eq.kk) then
                     ijk=ll
                     ll=jj
                     jj=ijk
                     isgn=-isgn
                  endif
               endif
            endif
c
c            if(isgn.eq.-1) yhh=.not.yhh
            y(iadr)=.true.
            aa(iadr)=a*isgn
            yh(iadr)=yhh
c          print*,'YH',iadr,a*isgn,isgn,aaaaa,yh(iadr),'  ',file
c           if(a.eq.-aaaaa.and..not.yhh) stop
            coef(iadr,1)=char(ii)
            if(icas.le.10) then
               coef(iadr,2)=char(jj)
               coef(iadr,3)=char(kk)
            else
               coef(iadr,2)=char(kk)
               coef(iadr,3)=char(jj)
            endif
            coef(iadr,4)=char(ll)
 10         continue
         enddo
      enddo
c=================================================================
c     fin de la lecture des integrales
c     les indices sont stockes dans coef(iaa)
c     les valeurs des int sont stockees dans aa(iaa)
c=================================================================
      if(yw)print*,'fin mise en memoire des int dans l''ordre des adr'
c     on met a zero les int absentes
c      do k=1,iii
c         if(.not.y(k)) then
c            aa(k)=0.d0
c         endif
c      enddo
      if(file.ne.'CDI_2111'.or.yw) then
         do k=1,iii
            if(.not.y(k).and.aa(k).ne.0.d0) then
               print*,'int absente',k
            endif
         enddo
      endif
c====================================================
c     on enleve les integrales absentes
c====================================================
c      if(itest(66).eq.1) then
c         iij=0
c         icas7=0
c         do k=1,iii
c            if(y(k)) then
c               call disin7(coef,icas7)
c               iij=iij+1
c               do kk=1,4
c                  coef(iij,kk)=coef(k,kk)
c               enddo
c               aa(iij)=aa(k)
c               yh(iij)=yh(k)
c            endif
c         enddo
c         print*,'iii,iij',iii,iij
c         iii=iij
c      endif
c====================================================
c     stockage dans l'ordre des adresses
c     on reecrit les int reordonnees sur les files
c     CDI_.... et CDE_....
c====================================================
      yre=.false.
      if(file.eq.'CDI_2111'.and.icas.eq.8) then
         close(29)
         open(29,file='CDI_211a',status='unknown',form='unformatted')
         if(yw)print*,'ouverture CDI_211a'
      else
         rewind 29
      endif
c      print*,'iii',iii
c      print*,'itest(26)',itest(26)
 29   continue
      if(yw) then
         do k=1,iii
            write(6,'(a15,4i4,f10.6)')
     *      'stockage INT',ichar(coef(k,1)),
     *      ichar(coef(k,2)),ichar(coef(k,3)),ichar(coef(k,4)),aa(k)
         enddo
         call flush(6)
      endif
      if(itest(26).eq.1) then
         do ii=1,iii,1024
            call disin6(coef(ii,1),coef(ii,2),coef(ii,3),coef(ii,4),
     *      aa(ii))
         enddo
      else
         do ii=1,iii,1024
            do k=1,1024
               kk=ii-1+k
               if(kk.gt.iii) goto 7
               inti(k)=ichar(coef(k,1))
               intj(k)=ichar(coef(k,2))
               intk(k)=ichar(coef(k,3))
               intl(k)=ichar(coef(k,4))
               if(inti(k).le.0) inti(k)=inti(k)+256
               if(intj(k).le.0) intj(k)=intj(k)+256
               if(intk(k).le.0) intk(k)=intk(k)+256
               if(intl(k).le.0) intl(k)=intl(k)+256
               write(6,'(a15,4i4,f10.6)')
     *         'stockage int',inti(k),
     *         intj(k),intk(k),intl(k),aa(k)
            enddo
 7          continue
            write(29)(inti(k),k=1,1024)
     *      ,(intj(k),k=1,1024)
     *      ,(intk(k),k=1,1024)
     *      ,(intl(k),k=1,1024)
     *      ,(aa(ii-1+k),k=1,1024)
         enddo
      endif
      if(file.eq.'CDI_2111'.and.yre) then
         yre=.false.
         do k=1,iii
            coe=coef(k,2)
            coef(k,2)=coef(k,4)
            coef(k,4)=coe
         enddo
         goto 29
      endif
      if(ihab.ne.0) then
c         do k=1,iii
c            print*,'YHH',k,yh(k),'  ',file
c         enddo
         do ii=1,iii,1024
            call ecry(yh(ii),1024,53)
         enddo
      endif
      close (29)
      close (53)
      if(yw)print*,'nombre d integrales stockees',iii
      return
      end
       subroutine disin52(file,llll,iiii,ns1,ns2,ns3,ns4,
     *aa,coef,y,yh,y66)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      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
      dimension iadrs(maxsym,maxsym,maxsym+4)
      dimension ns1(maxsym),ns2(maxsym),ns3(maxsym),ns4(maxsym)
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      common/sy7/inumsy(maxsym,maxorb)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sy3/itorbi(maxorb),isbrot(maxorb),itorbc(maxorb)
     *,itorbs(maxorb)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/sy4/ntstot(0:maxsym),ncstot(0:maxsym),npstot(0:maxsym)
      common /nummrs/nummr(maxorb)
      character*8 file,file1
      dimension aa(iadri)
      common/test/itest(100)
      character*1 coef(iadri,4)
      dimension y(iadri),yh(iadri)
      dimension isgna0(maxorb),isgnb0(maxorb)
      common/ad2111/ id2111(maxorb)
      common/opt/ihab,calcul
      character*3 calcul
      common/pr/nprint,mprint(10)
      if(y66) return
      yw=.false.
      yw1=.false.
      yi211a=icas.eq.8
      yi211b=icas.eq.9
      yi211c=icas.eq.10
      ye2111=icas.eq.11
      if(yi211a) file1='CDI_211a'
      if(yi211b) file1='CDI_211b'
      if(yi211c) file1='CDI_211c'
      if(ye2111) file1='CDE_2111'
      iii=0
      if(yw)print*,'debut','  ',file1,icas,yi211a,yi211b,yi211c,ye2111
c
c     cas a)  dans Cjkl, on a  k<l
c     cas b)  on a Cjjl, on a  k=l
c     cas c)  dans Cjkl, on a  k>l
c
c
c     methode : pour les cas a et c :
c     - on prepare l'adressage
c     - on lit une integrale Cjkl
c       on la stocke si k<l (resp k>l)
c     - on echange j et l
c       on recommence a tester k<l (resp k>l), et on la stocke
c       eventuellement
c     - pour le cas b) idem
c
c
c     classes d'equivalence
c
      if(yw)print*,'icas',icas
c     symetries differentes   1 2 3 4
      if(yi211b) goto 22
      do is=1,nsym
         do js=1,nsym
            if(js.eq.is) goto 21
            ijs=its(is,js)
            do ks=1,nsym
               if(ks.eq.is) goto 2
               if(ks.eq.js) goto 2
               ls=its(ijs,ks)
               if(ls.eq.is) goto 2
               if(yi211a.and.ks.gt.ls) goto 2
               if(yi211c.and.ks.lt.ls) goto 2
               if(ye2111.and.ks.lt.ls) goto 2
               iadrs(is,js,ks)=iii
               if(yw) then
                  write(75,*)'0 is,js,ks,iadrs',is,js,ks,iadrs
     *            (is,js,ks),ns1(is),ns2(js),ns3(ks),ns4(ls),'$'
                  call scril
               endif
               iii=iii+ns1(is)*ns2(js)*ns3(ks)*ns4(ls)
 2             continue
            enddo
 21         continue
         enddo
      enddo
c     symetries 1 2 1 2     pour ye2111 j.ne.l
      do is=1,nsym
         do js=1,nsym
            if(is.eq.js) goto 71
            if(yi211a.and.is.gt.js) goto 71
            if(yi211c.and.is.lt.js) goto 71
            if(ye2111.and.is.gt.js) goto 71
            iadrs(is,js,maxsym+1)=iii
            if(yw) then
               write(75,*)'1 is,js,9,Iadrs',is,js,iadrs
     *         (is,js,maxsym+1),ns1(is),ns2(js),
     *         ns3(is),ns4(js),'$'
               call scril
            endif
            if(ye2111) then
               iii=iii+ns1(is)*ns3(is)*(ns2(js)-1)*ns4(js)
            else
               iii=iii+ns1(is)*ns3(is)*ns2(js)*ns4(js)
            endif
 71         continue
         enddo
      enddo
c     symetries 1 2 1 2     seulement ye2111 j=l
      if(ye2111) then
         do is=1,nsym
            do js=1,nsym
               if(is.eq.js) goto 72
               iadrs(is,js,maxsym+4)=iii
               if(yw) then
                  write(75,*)'1'' is,js,9,Iadrs',is,js,iadrs
     *            (is,js,maxsym+4),'$'
                  call scril
               endif
               iii=iii+ns1(is)*ns3(is)*ns4(js)
 72            continue
            enddo
         enddo
      endif
c     symetries 1 2 2 1
      do is=1,nsym
         do js=1,nsym
            if(is.eq.js) goto 40
            iadrs(is,js,maxsym+2)=iii
            if(yi211a.and.is.lt.js) goto 40
            if(yi211c.and.is.gt.js) goto 40
            if(ye2111.and.is.lt.js) goto 40
            if(yw) then
               write(75,*)'2 is,js,10,iadrs',is,js,iadrs
     *         (is,js,maxsym+2),'$'
               call scril
            endif
            if(ye2111) then
c                 alors j.ne.k
               iii=iii+ns1(is)*ns2(js)*(ns3(js)-1)*ns4(is)
            else
               iii=iii+ns1(is)*ns2(js)*ns3(js)*ns4(is)
            endif
 40         continue
         enddo
      enddo
 22   continue
 4    continue
c      if(yi211b) goto 23
c     symetries 1 1 2 2
      do is=1,nsym
         do ks=1,nsym
            if(is.eq.ks) goto 8
            iadrs(is,ks,maxsym+3)=iii
            if(yw) then
               write(75,*)'3 is,ks,11,iadrs',is,ks,iadrs
     *         (is,ks,maxsym+3),'$'
               call scril
            endif
            if(yi211b) then
               iii=iii+ns1(is)*ns2(is)*ns3(ks)
            else
               iii=iii+ns1(is)*ns2(is)*ns3(ks)*(ns3(ks)-1)/2
            endif
 8          continue
         enddo
      enddo
c 23   continue
c     symetries egales 1 1 1 1     pour ye2111  j.ne.l
      do is=1,nsym
         iadrs(is,is,maxsym+3)=iii
         if(yw) then
            write(75,*)'4 is,12,iadrs',is,iadrs
     *      (is,is,maxsym+3),'$'
            call scril
         endif
         nsj=ns2(is)
         if(yi211b) then
            iii=iii+ns1(is)*nsj*nsj
         else if(ye2111) then
c           alors k<l et j.ne.l et j.ne.k
            iii=iii+ns1(is)*(nsj-2)*nsj*(nsj-1)/2
         else
            iii=iii+ns1(is)*nsj*nsj*(nsj-1)/2
         endif
      enddo
 3    continue
c     symetries egales 1 1 1 1     seulement ye2111  j=l
      if(.not.ye2111) goto 31
      do is=1,nsym
         iadrs(is,is,maxsym+2)=iii
         if(yw) then
            write(75,*)'4'' is,12,iadrs',is,iadrs
     *      (is,is,maxsym+2),'$'
            call scril
         endif
c        k.ne.j
         nsj=ns2(is)
         iii=iii+ns1(is)*(nsj-1)*nsj
      enddo
 31   continue
      if(yw)print*,'dimension max ',file,iii
c
c**********************************************
c     lecture et mise en memoire des integrales
c     classement en fonction de leur adresse
c**********************************************
c
      do k=1,iii
         y(k)=.false.
         yh(k)=.false.
         aa(k)=0.d0
      enddo
      open(29,status='old',form='unformatted',file=file)
      if(ihab.ne.0)
     *open(53,status='unknown',form='unformatted',file='H'//file1(2:8))
      if(yw)print*,'llll,iiii',llll,iiii,llll*1024+iiii
      do ln=1,llll+1
         call lirin4(inti,intj,intk,intl,aaint,29)
         lfini=1024
         if(ln.eq.llll+1)lfini=iiii
         do in=1,lfini
            i=inti(in)
            j=intj(in)
            k=intk(in)
            l=intl(in)
            yret=j.ne.l.and..not.ye2111
 11         continue
c            print*,'avant',i,j,k,l,yi211a,yi211b,yi211c,ye2111
            if(yi211a) then
               if(k.ge.l) goto 10
            else if(yi211b) then
               if(k.ne.l) goto 10
            else if(yi211c) then
               if(k.le.l) goto 10
            endif
c            print*,'apres',i,j,k,l
            a=aaint(in)
            aaaaa=a
            yhh=.false.
 9          continue
c            if(yw)print'(a20,4i3,f12.8)','apres lect i,j,k,l',i,j,k,l,a
c
c           signe pour les integrales directes
c
c--            changement de signe pour les int <ijil>
c              si i est inactive
            if(file(3:3).eq.'I') then
               if(j.eq.l) then
                  a=-a
                  yhh=.not.yhh
               endif
            endif
            isgno=1
            ii=itorbc(i)
            jj=itorbc(j)
            kk=itorbc(k)
            ll=itorbc(l)
            im=min(ii,kk)
            jm=min(jj,ll)
            km=max(ii,kk)
            lm=max(jj,ll)
            if(yw)print'(a10,3(4i3,2x))','i,j,k,l',i,j,k,l,ii,jj,kk,ll
            do kkk=1,ninac
               isgna0(kkk)=1
               isgnb0(kkk)=1
            enddo
            jjj=min(jj,ll)
            lll=max(jj,ll)
            if(file(3:3).eq.'I') then
               do kkk=jjj+1,lll-1
                  isgnb0(kkk)=-isgnb0(kkk)
               enddo
            else
               do kkk=jjj+1,lll-1
                  isgna0(kkk)=-isgna0(kkk)
               enddo
            endif
            do kkk=kk+1,ninac
               isgna0(kkk)=-isgna0(kkk)
            enddo
            if(file(3:3).eq.'I') then
               isgnb0(jj)=1
            else
               isgna0(jj)=1
            endif
            isgna0(kk)=1
            if(file(3:3).eq.'I') then
               isgnb0(ll)=1
            else
               isgna0(ll)=1
            endif
 
 
 
 
            if(yw)print'(a7,10i3)','isgna0',(isgna0(kkk),kkk=1,ninac)
            if(yw)print'(a7,10i3)','isgnb0',(isgnb0(kkk),kkk=1,ninac)
            isgno=1
            do kkk=1,ninac
               isgno=isgno*isgna0(kkk)*isgnb0(kkk)
            enddo
            a=a*isgno
            if(isgno.eq.-1) yhh=.not.yhh
c               if(yw)print'(a6,5i3,f12.8,a9)','isgno'
c     *         ,i,j,k,l,isgno,a,file
c
c     signe pour les integrales directes + echange
c
c--         changement de signe pour les int <ijil> si i est
c           entre j et l
            if(file(3:3).eq.'E') then
               if(i.eq.k.and.
     *         (isbrot(l)-isbrot(i))*(isbrot(j)-isbrot(i)).lt.0) then
                  a=-a
                  yhh=.not.yhh
               endif
               if(j.eq.l.and.
     *         (isbrot(k)-isbrot(j))*(isbrot(i)-isbrot(j)).lt.0) then
                  a=-a
                  yhh=.not.yhh
               endif
               if(yw)print*,
     *         'isbrot a',a,isbrot(i),isbrot(j),isbrot(k),
     *         isbrot(l)
            endif
            call disadr5(i,j,k,l,ii,jj,kk,ll,
     *      iadr,iadrs,ns1,ns2,ns3,ns4,file,isgn,icas)
            if(yw) then
c               if(itsym(i).eq.3.and.itsym(j).eq.2.and.itsym(k).eq.4)
c     *         print'(a10,4i4,f10.6)','S1111',i,j,k,l,a
               write(75,*)'i,j,k,l,iadr,a,isgn',(ln-1)*1024+in,' / ',
     *         i,j,k,l,iadr,a,isgn,'$'
               call scril
            endif
            if(y(iadr)) then
               print*,'disin52 deja vu',iadr
               stop
            endif
            if(iadr.gt.iii.or.iadr.le.0) then
               print*,'disin5 adresse mauvaise',iadr,iii
               stop
            endif
c
c
c            if(isgn.eq.-1) yhh=.not.yhh
            y(iadr)=.true.
            aa(iadr)=a*isgn
            yh(iadr)=yhh
c          print*,'YH',iadr,a*isgn,isgn,aaaaa,yh(iadr),'  ',file
c           if(a.eq.-aaaaa.and..not.yhh) stop
            coef(iadr,1)=char(ii)
            coef(iadr,2)=char(jj)
            coef(iadr,3)=char(kk)
            coef(iadr,4)=char(ll)
 10         continue
            if(yret) then
               yret=.false.
               jljl=j
               j=l
               l=jljl
               goto 11
            endif
         enddo
      enddo
c=================================================================
c     fin de la lecture des integrales
c     les indices sont stockes dans coef(iaa)
c     les valeurs des int sont stockees dans aa(iaa)
c=================================================================
      if(yw)print*,'fin mise en memoire des int dans l''ordre des adr'
c     on met a zero les int absentes
c      do k=1,iii
c         if(.not.y(k)) then
c            aa(k)=0.d0
c         endif
c      enddo
      do k=1,iii
         if(.not.y(k).and.aa(k).ne.0.d0) then
            print*,'int absente',k
         endif
      enddo
c====================================================
c     stockage dans l'ordre des adresses
c     on reecrit les int reordonnees sur les files
c     CDI_.... et CDE_....
c====================================================
      close(29)
      open(29,file=file1,status='unknown',form='unformatted')
      if(yw)print*,'ouverture ',file1
 29   continue
      if(yw) then
         do k=1,iii
            write(6,'(a15,4i4,f10.6)')
     *      'stockage INT',ichar(coef(k,1)),
     *      ichar(coef(k,2)),ichar(coef(k,3)),ichar(coef(k,4)),aa(k)
         enddo
      endif
      if(itest(26).eq.1) then
         do ii=1,iii,1024
            call disin6(coef(ii,1),coef(ii,2),coef(ii,3),coef(ii,4),
     *      aa(ii))
         enddo
      else
         do ii=1,iii,1024
            do k=1,1024
               kk=ii-1+k
               if(kk.gt.iii) goto 7
               inti(k)=ichar(coef(k,1))
               intj(k)=ichar(coef(k,2))
               intk(k)=ichar(coef(k,3))
               intl(k)=ichar(coef(k,4))
               if(inti(k).le.0) inti(k)=inti(k)+256
               if(intj(k).le.0) intj(k)=intj(k)+256
               if(intk(k).le.0) intk(k)=intk(k)+256
               if(intl(k).le.0) intl(k)=intl(k)+256
               write(6,'(a15,4i4,f10.6)')
     *         'stockage int',inti(k),
     *         intj(k),intk(k),intl(k),aa(k)
            enddo
 7          continue
            write(29)(inti(k),k=1,1024)
     *      ,(intj(k),k=1,1024)
     *      ,(intk(k),k=1,1024)
     *      ,(intl(k),k=1,1024)
     *      ,(aa(ii-1+k),k=1,1024)
         enddo
      endif
      if(ihab.ne.0) then
c         do k=1,iii
c            print*,'YHH',k,yh(k),'  ',file
c         enddo
         do ii=1,iii,1024
            call ecry(yh(ii),1024,53)
         enddo
      endif
      close (29)
      close (53)
      if(yw)print*,'nombre d integrales stockees',iii
      return
      end
       subroutine disadr5(i,j,k,l,ii,jj,kk,ll,
     *iadr,iadrs,ns1,ns2,ns3,ns4,file,isgn,icas)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      dimension iadrs(maxsym,maxsym,maxsym+4)
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common /prep2/ icatt(2,maxsym,maxsym,-1:1),
     *icatp(2,maxsym,maxsym,-1:1)
     *,itorb(maxorb*2),icatc(maxsym,maxsym,0:maxorbcas,0:maxorbcas)
      dimension ns1(maxsym),ns2(maxsym),ns3(maxsym),ns4(maxsym)
      common/ad2111/ id2111(maxorb)
      character*8 file
      common/pr/nprint,mprint(10)
      yw=nprint.ge.3
c      print*,'entree disadr5 file',file
      isgn=1
      yippj=itsym(i).lt.itsym(j).or.itsym(i).eq.itsym(j).and.i.lt.j
      ii=i
      jj=j
      kk=k
      ll=l
      if(file.eq.'CDI_2233'.or.file.eq.'CDI_1122') then
         if(yippj) then
c            ii=i
c            jj=j
c            kk=k
c            ll=l
         else
            ii=j
            jj=i
            kk=l
            ll=k
         endif
      else if (file.eq.'CDE_2233'.or.file.eq.'CDE_1122') then
         if(yippj) then
c            ii=i
c            jj=j
         else
            ii=j
            jj=i
            isgn=-1
         endif
         if(k.lt.l) then
c            kk=k
c            ll=l
         else
            kk=l
            ll=k
            isgn=-isgn
         endif
      else if (file.eq.'CDI_2323'.or.file.eq.'CDI_1212') then
         if(yippj) then
c            ii=i
c            jj=j
         else
            ii=j
            jj=i
         endif
         if(k.lt.l) then
c            kk=k
c            ll=l
         else
            kk=l
            ll=k
         endif
      else if (file.eq.'CDE_2323'.or.file.eq.'CDE_1212') then
         if(yippj) then
c            ii=i
c            jj=j
c            kk=k
c            ll=l
         else if (i.eq.j) then
c            ii=i
c            jj=j
            if(k.lt.l) then
c               kk=k
c               ll=l
            else
               kk=l
               ll=k
               isgn=-isgn
            endif
         else
            ii=j
            jj=i
            kk=l
            ll=k
         endif
      else if(file.eq.'CDE_2133'.or.file.eq.'CDE_2311'
     *   ) then
         if(k.gt.l) then
            kk=l
            ll=k
            isgn=-isgn
         endif
      else if(file.eq.'CDI_2131'
     *   .or.file.eq.'CDI_2313'.or.file.eq.'CDI_2131'
     *   .or.file.eq.'CDI_2313') then
         if(k.gt.l) then
            kk=l
            ll=k
         endif
      else if(file.eq.'CDE_2213') then
         if(.not.yippj) then
            ii=j
            jj=i
            isgn=-1
         endif
      else if(file.eq.'CDI_2123') then
         if(.not.yippj) then
            ii=j
            jj=i
         endif
c      else if(file.eq.'CDI_2111') then
c         if(j.lt.l) then
c            jj=j
c            ll=l
c         else
c            jj=l
c            ll=j
c         endif
      endif
      isi=itsym(ii)
      isj=itsym(jj)
      isk=itsym(kk)
      isl=itsym(ll)
      iii=itorb(ii)
      jjj=itorb(jj)
      kkk=itorb(kk)
      lll=itorb(ll)
      if(yw)print*,'file,i,j,k,l',file,i,j,k,l
      if(yw)print*,'ii,jj,kk,ll',ii,jj,kk,ll
c      print*,'iii,jjj,kkk,lll',iii,jjj,kkk,lll
      if(yw)print*,'sym',isi,isj,isk,isl
      if(yw)print*,'sym',ns1(isi),ns2(isj),ns3(isk),ns4(isl)
      if(isi.ne.isj) then
         iadr=kkk+(lll-1)*ns3(isk)+(jjj-1)*ns3(isk)*ns4(isl)
     *   +(iii-1)*ns3(isk)*ns4(isl)*ns2(isj)+iadrs(isi,isj,isk)
         if(file.eq.'CDE_2111') then
            nsj=ns2(isj)
            nsk=ns3(isk)
            nsl=ns4(isl)
            if(isi.eq.isk) then
c              sym 1 2 1 2
c              il faut distinguer les cas j.ne.l et j=l
               if(j.eq.l) then
c                  print*,'iadrs',isi,isj,iadrs(isi,isj,maxsym+4)
                  iadr=lll+(kkk-1)*nsl+(iii-1)*nsk*nsl
     *            +iadrs(isi,isj,maxsym+4)
               else
c                 j.ne.l
                  if(jjj.lt.lll) then
                     jjj1=jjj
                  else
                     jjj1=jjj-1
                  endif
c      print*,'iii,jjj,kkk,lll',iii,jjj,kkk,lll,jjj1,
c     * iadrs(isi,isj,maxsym+1)
c      print*,'sym',nsi,nsJ,nsk,nsl
                  iadr=lll+(kkk-1)*nsl+(jjj1-1)*nsl*nsk
     *            +(iii-1)*nsl*nsk*(nsj-1)
     *            +iadrs(isi,isj,maxsym+1)
               endif
            else
               if(isj.eq.isk) then
c                 sym 1 2 2 1
c              j.ne.k
                  if(jjj.lt.kkk) then
                     jjj1=jjj
                  else
                     jjj1=jjj-1
                  endif
                  iadr=lll+(kkk-1)*nsl+(jjj1-1)*nsl*nsk
     *            +(iii-1)*nsl*nsk*(nsj-1)
     *            +iadrs(isi,isj,maxsym+2)
               endif
            endif
         else if(file.eq.'CDI_2111') then
            nsj=ns2(isj)
            nsk=ns3(isk)
            nsl=ns4(isl)
            if(isi.eq.isk) then
c                 sym 1 2 1 2
c                 cas a) ou c)
c               print*,'iii,jjj,kkk,lll,',iii,jjj,kkk,lll,
c     *         iadrs(isi,isj,maxsym+1)
               iadr=lll+(kkk-1)*nsl+(jjj-1)*nsl*nsk+
     *         (iii-1)*nsl*nsk*nsj
     *         +iadrs(isi,isj,maxsym+1)
            else
               if(isj.eq.isk) then
c                    sym 1 2 2 1
c                    cas a) ou c)
c                  print*,'iii,jjj,kkk,lll,',iii,jjj,kkk,lll,
c     *            iadrs(isi,isj,maxsym+2)
                  iadr=lll+(kkk-1)*nsl+(jjj-1)*nsl*nsk+
     *            (iii-1)*nsl*nsk*nsj
     *            +iadrs(isi,isj,maxsym+2)
               else
c                    sym 1 2 3 4
c                    cas a) ou c)
c                    cas a) ou c)
                  iadr=lll+(kkk-1)*nsl+(jjj-1)*nsl*nsk+
     *            (iii-1)*nsl*nsk*nsj
     *            +iadrs(isi,isj,isk)
               endif
            endif
         endif
      else
         if(file.eq.'CDI_2233'.or.file.eq.'CDE_2323'
     *   .or.file.eq.'CDI_1122'.or.file.eq.'CDE_1212') then
            if(i.eq.j) then
               if(k.eq.l) then
                  iadr=lll+(iii-1)*ns4(isl)+iadrs(isi,isk,maxsym+4)
               else
                  iadrp=(lll-1)*(lll-2)/2+kkk
                  iadr=iadrp+(iii-1)*ns4(isl)*(ns4(isl)-1)/2
     *            +iadrs(isi,isk,maxsym+2)
               endif
            else
               if(k.eq.l) then
                  iadr=lll+((jjj-2)*(jjj-1)/2+iii-1)*
     *            ns4(isl)
     *            +iadrs(isi,isk,maxsym+3)
               else
c                  iadrp=lll+(kkk-1)*ns4(isl)
c                  iadrp=iadrp-(iadrp-1)/(ns4(isl)+1)-1
                  if(kkk.lt.lll) then
                     iadrp=(lll-1)*(lll-2)/2+kkk
                  else
                     iadrp=(kkk-1)*(kkk-2)/2+lll+ns4(isl)*(ns4(isl)-1)/2
                  endif
                  if(yw)print*,'iadrp',iadrp
                  iadr=iadrp+((jjj-1)*(jjj-2)/2+iii-1)*
     *            ns4(isl)*(ns4(isl)-1)
     *            +iadrs(isi,isk,maxsym+1)
               endif
            endif
         else if(file.eq.'CDE_2233'.or.file.eq.'CDE_1122') then
            iadr=(lll-2)*(lll-1)/2+kkk+((jjj-2)*(jjj-1)/2+iii-1)*
     *      ns4(isl)*(ns4(isl)-1)/2
     *      +iadrs(isi,isk,maxsym+1)
         else if(file.eq.'CDI_2323'.or.file.eq.'CDI_1212') then
            if(i.eq.j) then
               iadrp=(lll-1)*(lll-2)/2+kkk
               iadr=iadrp+(iii-1)*ns4(isl)*(ns4(isl)-1)/2
     *         +iadrs(isi,isk,maxsym+2)
            else
               if(k.eq.l) then
                  iadr=lll+((jjj-2)*(jjj-1)/2+iii-1)*
     *            ns3(isk)
     *            +iadrs(isi,isk,maxsym+3)
               else
                  iadrp=(lll-2)*(lll-1)/2+kkk
                  iadr=iadrp+((jjj-1)*(jjj-2)/2+iii-1)*
     *            ns3(isk)*(ns3(isk)-1)/2
     *            +iadrs(isi,isk,maxsym+1)
               endif
            endif
         else if(file.eq.'CDI_2133'.or.file.eq.'CDI_2311'
     *      .or.file.eq.'CDE_2313'.or.file.eq.'CDE_2131'
     *      ) then
            if(k.eq.l) then
               iadr=lll+(jjj+(iii-1)*ns2(isj)-1)*ns4(isl)
c               iadr=iii+(jjj-1)*ns1(isi)+(lll-1)*ns1(isi)*ns2(isj)
c               iadr=lll+(iii+(jjj-1)*ns1(isi)-1)*ns4(isl)
     *         +iadrs(isi,isk,maxsym+3)
            else
               if(kkk.lt.lll) then
                  iadrp=(lll-1)*(lll-2)/2+kkk
               else
                  iadrp=(kkk-1)*(kkk-2)/2+lll+ns4(isl)*(ns4(isl)-1)/2
               endif
c               iadr=iii+(jjj-1)*ns1(isi)+(iadrp-1)*ns1(isi)*ns2(isj)+
c     *         iadrs(isi,isk,maxsym+1)
c                iadr=iadrp+(jjj+(iii-1)*ns2(isj)-1)*ns4(isl)*
c     *          (ns4(isl)-1)+iadrs(isi,isk,maxsym+1)
               iadr=jjj+(iadrp-1)*ns2(isj)+
     *         (iii-1)*ns4(isl)*(ns4(isl)-1)*ns2(isj)
     *         +iadrs(isi,isk,maxsym+1)
               if(yw)print*,'iadrs',iadrs(isi,isk,maxsym+1)
            endif
         else if(file.eq.'CDE_2111') then
            nsj=ns2(isj)
            nsk=ns3(isk)
            nsl=ns4(isl)
            if(isi.eq.isk) then
c              sym 1 1 1 1
               if(j.eq.l) then
                  if(k.gt.l) then
c       print*,(kkk-1)*(kkk-2)/2
c       print*,(iii-1)*nsk*(nsk-1)/2
c       print*,iadrs(isi,isi,maxsym+2)
c       print*,lll
c       print*,k,l,kkk,lll
                     iadr=(kkk-1)*(kkk-2)/2+lll+(iii-1)
     *               *nsk*(nsk-1)
     *               +iadrs(isi,isi,maxsym+2)
                  else
                     iadr=(lll-1)*(lll-2)/2+kkk+(iii-1)
     *               *nsl*(nsl-1)
     *               +nsk*(nsk-1)/2
     *               +iadrs(isi,isi,maxsym+2)
                  endif
               else
c                 alors k<l et j.ne.l et j.ne.k
                  jjj1=jjj
                  if(jjj.gt.kkk) jjj1=jjj1-1
                  if(jjj.gt.lll) jjj1=jjj1-1
                  iadr=(lll-1)*(lll-2)/2+kkk
     *            +(jjj1-1)*nsl*(nsl-1)/2
     *            +(iii-1)*(nsj-2)*nsl*(nsl-1)/2
     *            +iadrs(isi,isi,maxsym+3)
               endif
            else
c              sym 1 1 2 2
c      print*,'iii,jjj,kkk,lll',iii,jjj,kkk,lll,
c     * iadrs(isi,isk,maxsym+3)
c      print*,'sym',nsJ,nsk,nsl
               iadr=(lll-1)*(lll-2)/2+kkk
     *         +(jjj-1)*nsl*(nsl-1)/2
     *         +(iii-1)*nsj*nsl*(nsl-1)/2
     *         +iadrs(isi,isk,maxsym+3)
            endif
         else if(file.eq.'CDI_2111') then
            nsj=ns2(isj)
            nsk=ns3(isk)
            nsl=ns4(isl)
c            print*,'isi,isj,isk,isl',isi,isj,isk,isl
            if(isi.eq.isj) then
               if(isi.eq.isk) then
c                 sym 1 1 1 1
                  if(k.eq.l) then
c                    cas b)
                     iadr=lll+(jjj-1)*nsl+(iii-1)*nsl*nsj+
     *               iadrs(isi,isi,maxsym+3)
                  else
                     if(k.lt.l) then
c                       cas a)
                        iadr=(lll-1)*(lll-2)/2+kkk+(jjj-1)*nsl*(nsl-1)/2
     *                  +(iii-1)*nsj*nsl*(nsl-1)/2
     *                  +iadrs(isi,isi,maxsym+3)
                     else if (k.gt.l) then
c                       cas c)
                        iadr=(kkk-1)*(kkk-2)/2+lll+(jjj-1)*nsl*(nsl-1)/2
     *                  +(iii-1)*nsj*nsk*(nsk-1)/2
     *                  +iadrs(isi,isi,maxsym+3)
                     endif
                  endif
               else
c                 sym 1 1 2 2
                  if(k.eq.l) then
c                    cas b)
c                     print*,'iii,jjj,kkk,lll,',iii,jjj,kkk,lll,
c     *               iadrs(isi,isk,maxsym+3)
                     iadr=lll+(jjj-1)*nsl+(iii-1)*nsl*nsj+
     *               iadrs(isi,isk,maxsym+3)
                  else if(k.lt.l) then
c                    cas a)
                     iadr=(lll-1)*(lll-2)/2+kkk+(jjj-1)*nsl*(nsl-1)/2
     *               +(iii-1)*nsj*nsl*(nsl-1)/2
     *               +iadrs(isi,isk,maxsym+3)
                  else
c                    cas c)
                     iadr=(kkk-1)*(kkk-2)/2+lll+(jjj-1)*nsl*(nsl-1)/2
     *               +(iii-1)*nsj*nsl*(nsl-1)/2
     *               +iadrs(isi,isk,maxsym+3)
                  endif
               endif
            else
               if(isi.eq.isk) then
c                 sym 1 2 1 2
c                 cas a) ou c)
                  iadr=lll+(kkk-1)*nsl+(jjj-1)*nsl*nsk+
     *            (iii-1)*nsl*nsk*nsj
     *            +iadrs(isi,isj,maxsym+1)
               else
                  if(isj.eq.isk) then
c                    sym 1 2 2 1
c                    cas a) ou c)
c                     print*,'iii,jjj,kkk,lll,',iii,jjj,kkk,lll,
c     *               iadrs(isi,isj,maxsym+2)
                     iadr=lll+(kkk-1)*nsl+(jjj-1)*nsl*nsk+
     *               (iii-1)*nsl*nsk*nsj
     *               +iadrs(isi,isj,maxsym+2)
                  else
c                    sym 1 2 3 4
c                    cas a) ou c)
c                    cas a) ou c)
                     iadr=lll+(kkk-1)*nsl+(jjj-1)*nsl*nsk+
     *               (iii-1)*nsl*nsk*nsj
     *               +iadrs(isi,isj,isk)
                  endif
               endif
            endif
C         else if(file.eq.'CDE_2111') then
C            iadr34=(lll-1)*(lll-2)/2+kkk
C            iadr12=(iii-1)*ns2(isj)+jjj
C            max34=ns4(isl)*(ns4(isl)-1)/2
C            if(yw)print*,'CDE_2111',iadr34,iadr12,max34
Cc            if(isi.eq.isk) then
Cc               max34=max(0,max34-2)
Cc               if(jjj.gt.kkk) iadr34=iadr34-1
Cc               if(jjj.gt.lll) iadr34=iadr34-1
Cc            endif
C            if(yw)print*,'2CDE_2111',iadr34,iadr12,max34
C            iadr=iadr34+(iadr12-1)*max34
C     *      +iadrs(isi,isk,maxsym+1)
         else if(file.eq.'CDE_2133'.or.file.eq.'CDE_2311') then
            iadrp=(lll-1)*(lll-2)/2+kkk
c            iadr=iii+(jjj-1)*ns1(isi)+(iadrp-1)*ns1(isi)*ns2(isj)+
c     *      iadrs(isi,isk,maxsym+1)
            iadr=iadrp+(jjj+(iii-1)*ns2(isj)-1)*ns4(isl)*(ns4(isl)-1)/2+
     *      iadrs(isi,isk,maxsym+1)
c            print*,'iadrp,iadrs',iadrp,iadrs(isi,isk,maxsym+1)
         else if(file.eq.'CDI_2313'.or.file.eq.'CDI_2131') then
            if(k.eq.l) then
               iadr=lll+(jjj+(iii-1)*ns2(isj)-1)*ns4(isl)
     *         +iadrs(isi,isk,maxsym+3)
            else
c               if(kkk.lt.lll) then
               iadrp=(lll-1)*(lll-2)/2+kkk
c               else
c                  iadrp=(kkk-1)*(kkk-2)/2+lll+ns4(isl)*(ns4(isl)-1)/2
c               endif
               iadr=iadrp+(jjj+(iii-1)*ns2(isj)-1)
     *         *ns4(isl)*(ns4(isl)-1)/2+
c               iadr=iii+(jjj-1)*ns1(isi)+(iadrp-1)*ns1(isi)*ns2(isj)+
     *         iadrs(isi,isk,maxsym+1)
c               print*,'iadrs,iadrp,ns4(isl)',iadrs(isi,isk,maxsym+1)
c     *         ,iadrp,ns4(isl)
            endif
         else if(file.eq.'CDI_2213'.or.file.eq.'CDE_2123') then
            iadr=kkk+(lll-1)*ns3(isk)+(iii-1)*ns3(isk)*ns4(isl)
     *      +(jjj-1)*ns3(isk)*ns4(isl)*ns1(isi)+iadrs(isi,isk,maxsym+1)
         else if(file.eq.'CDE_2213') then
            iadrp=kkk+(lll-1)*ns3(isk)
            iadr=iadrp+((jjj-1)*(jjj-2)/2+iii-1)*ns3(isk)*ns4(isl)
     *      +iadrs(isi,isk,maxsym+1)
         else if(file.eq.'CDI_2123') then
            jjjj=max(jjj,iii)
            iiii=min(jjj,iii)
            iadrp=kkk+(lll-1)*ns3(isk)
            iadr=iadrp+((jjjj-1)*jjjj/2+iiii-1)*ns3(isk)*ns4(isl)
     *      +iadrs(isi,isk,maxsym+1)
         else if(file.eq.'CDE_2123') then
            jjjj=max(jjj,iii)
            iiii=min(jjj,iii)
            iadrp=kkk+(lll-1)*ns3(isk)
            iadr=iadrp+((jjjj-1)*jjjj/2+iiii-1)*ns3(isk)*ns4(isl)
     *      +iadrs(isi,isk,maxsym+1)
         endif
      endif
c       print*,'iadrs(isi,isj,isk)',iadrs(isi,isj,isk)
      return
      end
       subroutine disin6(coef1,coef2,coef3,coef4,aa)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      character*1 coef1(1024),coef2(1024),coef3(1024),coef4(1024)
      dimension aa(1024)
      write(29) coef1,coef2,coef3,coef4,aa
      return
      end
 
