      subroutine cdrs0(a,b)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter(iadris=500000,iadristp=200000)
      common/dimis/ iadris1,iadristp1,maxsps
      dimension aa(iadris/2),iespaa(iadris),coef(iadris*4)
      character*1 coef
      equivalence (aa(1),iespaa(1))
      equivalence (iespaa(1),coef(1))
      common/sy2/nts(maxsym),ncs(maxsym),nps(maxsym)
     *,norbs(maxsym)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/dim/iadri ; integer(8) iadri
      common /icd1/ispin(2)
      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
      dimension a(iadri),b(iadri)
      common/test/itest(100)
      common/pert/schift,damp,ypertu,ycaspert
      common /combs/  C(0:maxorbcas+4,-1:maxorbcas+4)
      common /prep/ ndum,ndumb,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
      integer c
      yw=.false.
      iadris1=iadris
      iadristp1=iadristp
c
c-------------------------------------------------
c     integrales avec C
c-------------------------------------------------
c
      if(ypertu.and.ycaspert) goto 12
      open(60,file='CD_naa',form='unformatted',status='unknown')
      if(itest(38).eq.1) then
         call cdrs01('CDI_2233',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2233',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef)
         call cdrs01('CDI_2323',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2323',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef)
      endif
      if(itest(39).eq.1) then
         call cdrs01('CDI_1122',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef)
         call cdrs01('CDE_1122',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef)
         call cdrs01('CDI_1212',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef)
         call cdrs01('CDE_1212',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef)
      endif
      if(itest(40).eq.1) then
         call cdrs01('CDI_2133',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2133',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef)
         call cdrs01('CDI_2313',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2313',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef)
      endif
      if(itest(41).eq.1) then
         call cdrs01('CDI_2311',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2311',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef)
         call cdrs01('CDI_2131',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2131',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef)
      endif
      if(itest(42).eq.1) then
         call cdrs05('CDI_211a',a,b,ncs,nts,nts,nts,aa,
     *   iespaa,coef,1)
         call cdrs05('CDI_211a',a,b,ncs,nts,nts,nts,aa,
     *   iespaa,coef,2)
         call cdrs05('CDI_211b',a,b,ncs,nts,nts,nts,aa,
     *   iespaa,coef,1)
         call cdrs05('CDI_211b',a,b,ncs,nts,nts,nts,aa,
     *   iespaa,coef,2)
         call cdrs05('CDI_211c',a,b,ncs,nts,nts,nts,aa,
     *   iespaa,coef,1)
         call cdrs05('CDI_211c',a,b,ncs,nts,nts,nts,aa,
     *   iespaa,coef,2)
         call cdrs05('CDE_2111',a,b,ncs,nts,nts,nts,aa,
     *   iespaa,coef,0)
      endif
 12   continue
      if(itest(43).eq.1) then
         call cdrs01('CDI_2213',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2213',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef)
         call cdrs01('CDI_2123',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef)
         call cdrs01('CDE_2123',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef)
      endif
      return
      end
       subroutine cdrs01(file,a,b,ns1,ns2,ns3,ns4,it1,it2,it3,it4,
     *aa,iespaa,coef)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter(ndimnaa=maxsym**3+3*maxsym**2+1)
      common/dim/iadri ; integer(8) iadri
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      character*8 file
      dimension a(iadri),b(iadri)
      dimension ns1(maxsym),ns2(maxsym),ns3(maxsym),ns4(maxsym)
      character*1 syspin
      common/sysp1/syspin
      common/dimis/ iadris,iadristp,maxsps
      dimension aa(iadris/2),iespaa(iadris),coef(iadris*4)
      common/ad2111/ id2111(maxorb)
      character*1 coef
      common/pr/nprint,mprint(10)
      common/test/itest(100)
      common/naafi/naafil(ndimnaa),initnaa
      yw=nprint.ge.0
      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'
      initnaa=0
      nbc=0
      do k=5,8
         if(file(k:k).eq.'2') nbc=nbc+1
      enddo
      print*,'entree cdrs01 file ',file
      open(51,form='unformatted',status='old',file=file)
      call lirin4(inti,intj,intk,intl,aaint,51)
      i0=inti(1)
      j0=intj(1)
c
c     boucle sur les indices CAS
c
c     symetries differentes
      naa3=0
      iaa=1
      do is=1,nsym
         if(it1.eq.it2.and..not.yi2213.and..not.ye2123) then
            idebj=is+1
         else
            idebj=1
         endif
         do js=idebj,nsym
            if(is.eq.js) goto 5
            if(nbc.eq.1) then
               ncc=ns1(is)
            else
               ncc=ns1(is)*ns2(js)
            endif
            ijs=its(is,js)
            do ks=1,nsym
               ls=its(ijs,ks)
               if(yw)print*,'avant is,js,ks,ls,ns'
     *         ,is,js,ks,ls,ns1(is),ns2(js),ns3(ks),ns4(ls)
               if((ye2233.or.yi2323.or.ye2133.or.yi2313.or.ye2111
     *         )
     *         .and.ls.lt.ks) goto 2
               if(nbc.eq.1) then
                  naa=ns2(js)*ns3(ks)*ns4(ls)
               else
                  naa=ns3(ks)*ns4(ls)
               endif
               if(yw)print*,'is,js,ks,ls,ns'
     *         ,is,js,ks,ls,ns1(is),ns2(js),ns3(ks),ns4(ls)
               if(yw)print*,'0 appel cdrs03',ncc,naa
               if(yw)print*,'iadris,iadristp,maxsps'
     *            ,iadris,iadristp,maxsps
               if(yw)print*,'nbc,ncc,naa',nbc,ncc,naa
c               if(itsym(inti(iaa)).eq.is.and.
c               intj(iaa)).eq.js.and.
c               intk(iaa)).eq.ks.and.
c               intl(iaa)).eq.ls) goto 1002
               call cdrs03(i0,j0
     *         ,naa1,naa,iaa,ncc
     *         ,file,nbc)
 2             continue
            enddo
 5          continue
         enddo
      enddo
c     symetries egales, aucune orbitale egale
      do is=1,nsym
         if(nbc.eq.1) then
            ncc=ns1(is)
         else
            if(file.eq.'CDI_2213'.or.file.eq.'CDE_2123') then
               ncc=ns1(is)*ns2(is)
            else if(file.eq.'CDI_2123') then
               ncc=ns1(is)*(ns2(is)+1)/2
            else
               ncc=ns1(is)*(ns1(is)-1)/2
            endif
         endif
         do ks=1,nsym
            if(yw)print*,'1avant is,ks,ns',is,ks
               if(nbc.eq.1) then
                  if(ye2111) then
                     if(is.eq.ks) then
                        naa=ns2(ks)*(ns2(ks)-1)*(ns2(ks)-2)/2
                     else
                        naa=ns2(is)*ns4(ks)*(ns4(ks)-1)/2
                     endif
                  else
                     naa=ns2(is)*ns3(ks)*(ns3(ks)-1)/2
                  endif
               else
                  if(it3.eq.it4) then
                     naa=ns3(ks)*(ns3(ks)-1)/2
                  else
                     naa=ns3(ks)*ns4(ks)
                  endif
               endif
            if(yw)print*,'is,ks,ns,naa'
     *      ,is,ks,ns1(is),ns3(ks),ns4(ks),naa
            naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            if(yi2233.or.ye2323.or.yi2133.or.ye2313) then
               if(yw)print*,'ks,ns3(ks)',ks,ns3(ks)
               if(yw)print*,'1a appel cdrs03',ncc,naa
               call cdrs03(i0,j0
     *         ,naa1,naa,iaa,ncc
     *         ,file,nbc)
               call ecrnaa(naa)
               if(yw)print*,'1b appel cdrs03',ncc,naa
               if(yw)print*,'naa,naa1',naa,naa1
               call cdrs03(i0,j0
     *         ,naa1,naa,iaa,ncc
     *         ,file,nbc)
            else if(ye2233.or.yi2323.or.yi2213.or.ye2213
     *         .or.yi2123.or.ye2123
     *         .or.ye2133.or.yi2313.or.ye2111) then
               if(yw)print*,'1c appel cdrs03',ncc,naa
               call cdrs03(i0,j0
     *         ,naa1,naa,iaa,ncc
     *         ,file,nbc)
               call ecrnaa(naa)
            endif
         enddo
      enddo
      if(ye2233.or.ye2133.or.ye2111.or.yi2213.or.ye2213
     *.or.yi2123.or.ye2123) goto 3
      if(yi2133.or.ye2313.or.yi2313) goto 4
c     symetries egales, i=j
      do is=1,nsym
         ncc=ns1(is)
         do ks=1,nsym
            naa=(ns3(ks)-1)*ns3(ks)/2
            if(yw)print*,'2 appel cdrs03',ncc,naa
            naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
         enddo
      enddo
c     symetries egales, k=l
 4    continue
c      print*,'symetries egales, k=l'
      do is=1,nsym
         if(nbc.eq.1) then
            ncc=ns1(is)
         else
            ncc=ns1(is)*(ns1(is)-1)/2
         endif
         do ks=1,nsym
            if(nbc.eq.1) then
               naa=ns2(is)*ns3(ks)
            else
               naa=ns3(ks)
            endif
            if(yw)print*,'3 appel cdrs03',ncc,naa
            if(yw)print*,'is,ks,ns'
     *      ,is,ks,ns1(is),ns2(is),ns3(ks)
            naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
         enddo
      enddo
      if(yi2133.or.ye2313.or.yi2323.or.ye2323.or.yi2313)
     *goto 3
c     symetries egales, i=j, k=l
      do is=1,nsym
         ncc=ns1(is)
         do ks=1,nsym
            naa=ns3(ks)
            if(yw)print*,'is,ks,ns'
     *      ,is,ks,ns1(is),ns3(ks)
            if(yw)print*,'4 appel cdrs03',ncc,naa
            naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
         enddo
      enddo
 3    continue
      close(51)
      write(60) initnaa
      call ecri(naafil,initnaa,60)
      return
      end
       subroutine cdrs05(file,a,b,ns1,ns2,ns3,ns4,
     *aa,iespaa,coef,jcas)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter(ndimnaa=maxsym**3+3*maxsym**2+1)
      common/dim/iadri ; integer(8) iadri
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      character*8 file
      dimension a(iadri),b(iadri)
c      dimension aa(maxorb*maxorb)
      dimension ns1(maxsym),ns2(maxsym),ns3(maxsym),ns4(maxsym)
      character*1 syspin
      common/sysp1/syspin
      common/dimis/ iadris,iadristp,maxsps
      dimension aa(iadris/2),iespaa(iadris),coef(iadris*4)
      common/ad2111/ id2111(maxorb)
      character*1 coef
      common/pr/nprint,mprint(10)
      common/test/itest(100)
      common/naafi/naafil(ndimnaa),initnaa
      yw=nprint.ge.3
      yi211a=file.eq.'CDI_211a'
      yi211b=file.eq.'CDI_211b'
      yi211c=file.eq.'CDI_211c'
      ye2111=file.eq.'CDE_2111'
      yi2111=yi211a.or.yi211b.or.yi211c
      initnaa=0
      nbc=0
      if(yw)print*,'entree cdrs05 file ',file,' jcas=',jcas
      open(51,form='unformatted',status='old',file=file)
      iaa=1024
c
c     boucle sur les indices CAS
c
c     symetries differentes 1 2 3 4
      if(yi211b) goto 4
c      if(jcas.eq.2) goto 77
      do is=1,nsym
         ncc=ns1(is)
         do js=1,nsym
            if(is.eq.js) goto 5
            ncc=ns1(is)
            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
c               if(ls.le.js) goto 2
               if(yi211a.and.ks.gt.ls) goto 2
               if(yi211c.and.ks.lt.ls) goto 2
               if(ye2111.and.ks.gt.ls) goto 2
               naa=ns2(js)*ns3(ks)*ns4(ls)
c               if(yw)print*,'avant is,js,ks,ls,ns'
c     *         ,is,js,ks,ls,ns1(is),ns2(js),ns3(ks),ns4(ls)
               if(yw)print*,'is,js,ks,ls,ns'
     *         ,is,js,ks,ls,ns1(is),ns2(js),ns3(ks),ns4(ls)
               if(naa.eq.0) goto 2
               if(yw)print*,'0 appel cdrs03',ncc,naa
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               itest(48)=max(itest(48),naa)
               if(yw)print*,'iadris,iadristp,maxsps'
     *            ,iadris,iadristp,maxsps
               if(yw)print*,'nbc,ncc,naa,naa1',nbc,ncc,naa,naa1
c               call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *         iadris-iadristp-maxsps*3)
               call cdrs03(i0,j0
     *         ,naa1,naa,iaa,ncc
     *         ,file,nbc)
               call ecrnaa(naa)
 2             continue
            enddo
 5          continue
         enddo
      enddo
c 77   continue
c     symetries 1 2 1 2       pour ye2111 j.ne.l
      do is=1,nsym
         ncc=ns1(is)
         do js=1,nsym
            if(yw)print*,'1212',is,js,ns3(is),ns2(js)
            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
            if(ye2111) then
               naa=ns3(is)*(ns2(js)-1)*ns2(js)
            else
               naa=ns3(is)*ns2(js)*ns2(js)
            endif
            if(yw)print*,'1avant is,js,ns',is,js
            if(yw)print*,'is,js,ns,naa'
     *      ,is,js,ns1(is),ns3(js),ns4(js),naa
            if(naa.eq.0) goto 71
            naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            if(yw)print*,'js,ns3(ks)',js,ns3(ks)
            if(yw)print*,'1a appel cdrs03',ncc,naa
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
 71         continue
         enddo
      enddo
c     symetries 1 2 1 2       seulement ye2111 j=l
      if(.not.ye2111) goto 73
      do is=1,nsym
         ncc=ns1(is)
         do js=1,nsym
            if(is.eq.js) goto 72
            naa=ns3(is)*ns2(js)
            if(yw)print*,'1''avant is,js,ns',is,js
            if(yw)print*,'is,js,ns,naa'
     *      ,is,js,ns1(is),ns3(js),ns4(js),naa
            if(naa.eq.0) goto 72
            naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            if(yw)print*,'js,ns3(ks)',js,ns3(ks)
            if(yw)print*,'1a'' appel cdrs03',ncc,naa
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
 72         continue
         enddo
      enddo
 73   continue
c     symetries 1 2 2 1
      do is=1,nsym
         ncc=ns1(is)
         do js=1,nsym
            if(is.eq.js) goto 40
            if(yi211a) then
               if(js.gt.is) goto 40
               naa=ns2(js)*ns3(js)*ns4(is)
            else if (yi211c) then
               if(js.lt.is) goto 40
               naa=ns2(js)*ns3(js)*ns4(is)
            else if (yi211b) then
               naa=ns2(js)*ns4(is)
            else if(ye2111) then
               if(js.gt.is) goto 40
c              alors j.ne.k
               naa=ns2(js)*(ns3(js)-1)*ns4(is)
            endif
            if(yw)print*,'2 appel cdrs03',ncc,naa
            naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
 40         continue
         enddo
      enddo
c     symetries 1 1 2 2
 4    continue
      do is=1,nsym
         ncc=ns1(is)
         do ks=1,nsym
            if(is.eq.ks) goto 8
            if(yi211b) then
               naa=ns2(is)*ns3(ks)
            else
               naa=ns2(is)*ns3(ks)*(ns3(ks)-1)/2
            endif
            if(yw)print*,'3 appel cdrs03',ncc,naa
            if(yw)print*,'is,ks,ns'
     *      ,is,ks,ns1(is),ns2(is),ns3(ks)
            naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
 8          continue
         enddo
      enddo
 23   continue
c     symetries egales 1 1 1 1      pour ye2111  j.ne.l
      do is=1,nsym
         ncc=ns1(is)
         nsj=ns2(is)
         if(yi211b) then
            naa=nsj*nsj
         else if(ye2111) then
c           alors il y a 2 series : j=l puis j.ne.l
c           1) j.ne.l
c           alors k<l et j.ne.l et j.ne.k
            naa=(nsj-2)*nsj*(nsj-1)/2
            if(yw)print*,'is,ns'
     *      ,is,ns1(is),ns3(is)
            if(naa.eq.0) goto 76
            if(yw)print*,'4 appel cdrs03',ncc,naa
            naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
c           2) j=l
 76         continue
            naa=(nsj-1)*nsj
            if(yw)print*,'is,ns'
     *      ,is,ns1(is),ns3(is)
            if(naa.eq.0) goto 75
            if(yw)print*,'4'' appel cdrs03',ncc,naa
            naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs03(i0,j0
     *      ,naa1,naa,iaa,ncc
     *      ,file,nbc)
               call ecrnaa(naa)
            goto 75
         else
            naa=nsj*nsj*(nsj-1)/2
         endif
         if(yw)print*,'is,ns'
     *   ,is,ns1(is),ns3(is)
         if(yw)print*,'4 appel cdrs03',ncc,naa
         naa1=min(naa,iadris-iadristp-maxsps*3)
               itest(48)=max(itest(48),naa)
c         call verdim('dans cdrs01 naa1 trop petit naa max',naa,
c     *   iadris-iadristp-maxsps*3)
         call cdrs03(i0,j0
     *   ,naa1,naa,iaa,ncc
     *   ,file,nbc)
               call ecrnaa(naa)
 75      continue
      enddo
      close(51)
      write(60) initnaa
      call ecri(naafil,initnaa,60)
      return
      end
       subroutine cdrs03(i0,j0,naa1,naa,iaa,ncc
     *,file,nbc)
      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
      character*8 file
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      dimension a(iadri),b(iadri)
      character*1 syspin
      common/sysp1/syspin
      common /icd1/ispin(2)
      common/sy3/itorbi(maxorb),isbrot(maxorb),itorbc(maxorb)
     *,itorbs(maxorb)
      common/dimis/ iadris,iadristp,maxsps
      dimension aa(naa1),iespaa(iadris-naa1*3),coef(naa1,4)
      character*1 coef
      common/naadi/naadim
      common/pr/nprint,mprint(10)
      common/test/itest(100)
      do icc=1,ncc
         naa3=0
         do kaa=1,naa
            naa3=kaa
c           integrale suivante :
            iaa=iaa+1
            print*,'int',inti(iaa),intj(iaa),intk(iaa),intl(iaa)
            print*,'iaa,kaa',iaa,kaa
            if(iaa.gt.1024) then
               iaa=1
               call lirin4(inti,intj,intk,intl,aaint,51)
            endif
            ii=inti(iaa)
            if(nbc.eq.1) then
               if(ii.ne.i0) goto 1001
            else
               jj=intj(iaa)
               print*,'ii,jj,i0,j0',ii,jj,i0,j0,naa3
               if(ii.ne.i0.or.jj.ne.j0) goto 1001
               j0=jj
            endif
            i0=ii
         enddo
 1001    continue
         i0=ii
         j0=jj
         print*,'naa3 ecrit ',naa3
         call ecrnaa(naa3)
      enddo
      return
      end
       subroutine ecrnaa(naa)
      parameter(maxsym=8)
      parameter(ndimnaa=maxsym**3+3*maxsym**2+1)
      common/naafi/naafil(ndimnaa),initnaa
      initnaa=initnaa+1
      if(initnaa.gt.ndimnaa) stop'ecrnaa'
      naafil(initnaa)=naa
      return
      end
       subroutine lirnaa(naa)
      parameter(maxsym=8)
      parameter(ndimnaa=maxsym**3+3*maxsym**2+1)
      common/naafi/naafil(ndimnaa),initnaa
      initnaa=initnaa+1
      naa=naafil(initnaa)
      return
      end
