      subroutine cdrs(a,b)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16,maxda3=300)
      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 /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      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
      common/c66/ y66(3,3,3,3),ye66(3,3,3,3)
      character*4 gener
      integer c
      character*4 hab
      logical*1 bidia
      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
      yw=.false.
      iadris1=iadris
      iadristp1=iadristp
      if(ytana) then
         icpu=itemps(idum)
      endif
      if(norb.lt.256) then
         ind256=4
      else
         ind256=5
      endif
c
c-------------------------------------------------
c     integrales avec C
c-------------------------------------------------
c
      if(ypertu.and.ycaspert) goto 12
      if(itest(38).eq.1) then
         call cdrs1(ind256,'CDI_2233',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef,y66(2,2,3,3))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrsI2233  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
         call cdrs1(ind256,'CDE_2233',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef,ye66(2,2,3,3))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrsE2233  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
         call cdrs1(ind256,'CDI_2323',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef,y66(2,3,2,3))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrsI2323  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
         call cdrs1(ind256,'CDE_2323',a,b,ncs,ncs,nps,nps,2,2,3,3,aa,
     *   iespaa,coef,ye66(2,3,2,3))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrsE2323  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      endif
      if(itest(39).eq.1) then
         call cdrs1(ind256,'CDI_1122',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef,y66(2,2,1,1))
         call cdrs1(ind256,'CDE_1122',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef,ye66(2,2,1,1))
         call cdrs1(ind256,'CDI_1212',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef,y66(2,1,2,1))
         call cdrs1(ind256,'CDE_1212',a,b,ncs,ncs,nts,nts,2,2,1,1,aa,
     *   iespaa,coef,ye66(2,1,2,1))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrs1122  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      endif
      if(itest(40).eq.1) then
         call cdrs1(ind256,'CDI_2133',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef,y66(2,1,3,3))
         call cdrs1(ind256,'CDE_2133',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef,ye66(2,1,3,3))
         call cdrs1(ind256,'CDI_2313',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef,y66(2,3,1,3))
         call cdrs1(ind256,'CDE_2313',a,b,ncs,nts,nps,nps,2,1,3,3,aa,
     *   iespaa,coef,ye66(2,3,1,3))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrs2133  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      endif
      if(itest(41).eq.1) then
         call cdrs1(ind256,'CDI_2311',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef,y66(2,3,1,1))
         call cdrs1(ind256,'CDE_2311',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef,ye66(2,3,1,1))
         call cdrs1(ind256,'CDI_2131',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef,y66(2,1,3,1))
         call cdrs1(ind256,'CDE_2131',a,b,ncs,nps,nts,nts,2,3,1,1,aa,
     *   iespaa,coef,ye66(2,1,3,1))
      endif
      if(itest(42).eq.1) then
         if(y66(2,1,1,1)) then
         call cdrs1(ind256,'CDI_2111',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,y66(2,1,1,1))
         else
         call cdrs5('CDI_211a',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,1,y66(2,1,1,1))
         call cdrs5('CDI_211a',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,2,y66(2,1,1,1))
         call cdrs5('CDI_211b',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,1,y66(2,1,1,1))
         call cdrs5('CDI_211b',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,2,y66(2,1,1,1))
         call cdrs5('CDI_211c',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,1,y66(2,1,1,1))
         call cdrs5('CDI_211c',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,2,y66(2,1,1,1))
         endif
         if(ye66(2,1,1,1)) then
         call cdrs1(ind256,'CDE_2111',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,ye66(2,1,1,1))
         else
         call cdrs5('CDE_2111',a,b,ncs,nts,nts,nts,2,1,1,1,aa,
     *   iespaa,coef,0,ye66(2,1,1,1))
         endif
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrs2111  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      endif
 12   continue
      if(itest(43).eq.1) then
         call cdrs1(ind256,'CDI_2213',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef,y66(2,2,1,3))
         call cdrs1(ind256,'CDE_2213',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef,ye66(2,2,1,3))
         call cdrs1(ind256,'CDI_2123',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef,y66(2,1,2,3))
         call cdrs1(ind256,'CDE_2123',a,b,ncs,ncs,nts,nps,2,2,1,3,aa,
     *   iespaa,coef,ye66(2,1,2,3))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrs2213  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      endif
      if(itest(60).eq.1) then
         call cdrs1(ind256,'CDI_2221',a,b,ncs,ncs,nts,nps,2,2,2,1,aa,
     *   iespaa,coef,y66(2,2,2,1))
         call cdrs1(ind256,'CDE_2221',a,b,ncs,ncs,nts,nps,2,2,2,1,aa,
     *   iespaa,coef,ye66(2,2,2,1))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrs2221  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      endif
      if(itest(61).eq.1) then
         call cdrs1(ind256,'CDI_2223',a,b,ncs,ncs,nts,nps,2,2,2,3,aa,
     *   iespaa,coef,y66(2,2,2,3))
         call cdrs1(ind256,'CDE_2223',a,b,ncs,ncs,nts,nps,2,2,2,3,aa,
     *   iespaa,coef,ye66(2,2,2,3))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrs2223  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      endif
      call cdrs1(ind256,'CDI_3311',a,b,ncs,ncs,nts,nps,3,3,1,1,aa,
     *iespaa,coef,y66(1,1,3,3))
      call cdrs1(ind256,'CDE_3311',a,b,ncs,ncs,nts,nps,3,3,1,1,aa,
     *iespaa,coef,ye66(3,3,1,1))
      call cdrs1(ind256,'CDE_3131',a,b,ncs,ncs,nts,nps,3,1,3,1,aa,
     *iespaa,coef,ye66(3,1,3,1))
      if(ytana) then
         icpu1=itemps(idum)-icpu
         write(6,*) 'cdrs3311  cpu',icpu1
         icpu=itemps(idum)
         call flush(6)
      endif
      return
      end
       subroutine cdrs1(ind256,file,a,b,ns1,ns2,ns3,ns4,it1,it2,it3,it4,
     *aa,iespaa,coef,y66)
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8,maxorbcas=16)
      include 'maxorb.prm'
      parameter (maxmax=maxorbcas)
      common/dim/iadri ; integer(8) iadri
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      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
      dimension mbadsa(maxmax**4)
      common/naadi/naadim
      common/pr/nprint,mprint(10)
      common/test/itest(100)
!
!
!      character*1 c(1024,4)
!      real*8 aaa(1024)
!
!
!
      yw=nprint.ge.3
      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'
      if(yw)print*,'entree cdrs1 file ',file
c
      if(y66) then
         open(51,form='unformatted',status='old',file=file//'L')
         read(51) iad5,(mbadsa(k),k=1,iad5)
         close(51)
         if(yw)print*,'cdrs1 ouv',file
         if(yw)print*,'iad5,mbadsa',iad5,(mbadsa(k),k=1,iad5)
         open(51,form='unformatted',status='old',file=file)
         iaa=1024
         do ii=1,iad5
            naa=mbadsa(ii)
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'1le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
            naadim=naa1
            itest(48)=max(itest(48),naa)
            call cdrs2(iespaa(iiaa),coef(8*naa1+1),
     *      aa,naa,naa1,iaa,ncc,a,0,file,y66,ind256)
         enddo
         return
      endif
      if(index(file,'2').eq.0) return
 
 
      nbc=0
      do k=5,8
         if(file(k:k).eq.'2') nbc=nbc+1
      enddo
      open(51,form='unformatted',status='old',file=file)
c
c     boucle sur les indices CAS
c
c     symetries differentes
      iaa=1024
      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 cdrs3',ncc,naa
               if(norb.lt.256) then
                  naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
               else
                  naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
               endif
               if(naa1.ne.naa.and.naa1.le.100) then
                  print*,'2le nombre d''integrales prises simultanement'
     *            ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c                  stop
               endif
               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 cdrs1 naa1 trop petit naa max',naa,
c     *         iadris-iadristp-maxsps*3)
               call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *         ,naa1,naa,iaa,ncc,a,b
     *         ,0,file,y66)
 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
               if(norb.lt.256) then
                  naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
               else
                  naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
               endif
               if(naa1.ne.naa.and.naa1.le.100) then
                  print*,'3le nombre d''integrales prises simultanement'
     *            ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c                  stop
               endif
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 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 cdrs3',ncc,naa
               call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *         ,naa1,naa,iaa,ncc,a,b
     *         ,1,file,y66)
               if(yw)print*,'1b appel cdrs3',ncc,naa
               if(yw)print*,'naa,naa1',naa,naa1
               call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *         ,naa1,naa,iaa,ncc,a,b
     *         ,1,file,y66)
            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 cdrs3',ncc,naa
               call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *         ,naa1,naa,iaa,ncc,a,b
     *         ,1,file,y66)
            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 cdrs3',ncc,naa
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'4le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,2,file,y66)
         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 cdrs3',ncc,naa
            if(yw)print*,'is,ks,ns'
     *      ,is,ks,ns1(is),ns2(is),ns3(ks)
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'5le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,3,file,y66)
         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 cdrs3',ncc,naa
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'6le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,4,file,y66)
         enddo
      enddo
 3    continue
      close(51)
      return
      end
       subroutine cdrs5(file,a,b,ns1,ns2,ns3,ns4,it1,it2,it3,it4,
     *aa,iespaa,coef,jcas,y66)
      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
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      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)
      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
      nbc=0
      if(yw)print*,'entree cdrs5 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 cdrs3',ncc,naa
               if(norb.lt.256) then
                  naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
               else
                  naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
               endif
               if(naa1.ne.naa.and.naa1.le.100) then
                  print*,'7le nombre d''integrales prises simultanement'
     *            ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c                  stop
               endif
               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 cdrs1 naa1 trop petit naa max',naa,
c     *         iadris-iadristp-maxsps*3)
               call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *         ,naa1,naa,iaa,ncc,a,b
     *         ,jcas,file,y66)
 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
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'8le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 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 cdrs3',ncc,naa
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,jcas,file,y66)
 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
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'9le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 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 cdrs3',ncc,naa
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,jcas,file,y66)
 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 cdrs3',ncc,naa
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'0le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
               itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,jcas,file,y66)
 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 cdrs3',ncc,naa
            if(yw)print*,'is,ks,ns'
     *      ,is,ks,ns1(is),ns2(is),ns3(ks)
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'11le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
            itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,jcas,file,y66)
 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 cdrs3',ncc,naa
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'12le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
            itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,jcas,file,y66)
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 cdrs3',ncc,naa
            if(norb.lt.256) then
               naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
            else
               naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
            endif
            if(naa1.ne.naa.and.naa1.le.100) then
               print*,'13le nombre d''integrales prises simultanement'
     *         ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c               stop
            endif
            itest(48)=max(itest(48),naa)
c            call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *      iadris-iadristp-maxsps*3)
            call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *      ,naa1,naa,iaa,ncc,a,b
     *      ,jcas,file,y66)
            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 cdrs3',ncc,naa
         if(norb.lt.256) then
            naa1=min(naa,(iadris-iadristp-maxsps*3)/5)
               iiaa=3*naa1+1
         else
            naa1=min(naa,(iadris-iadristp-maxsps*3)*4/21-10)
               iiaa=13*naa1/4+2
         endif
         if(naa1.ne.naa.and.naa1.le.100) then
            print*,'14le nombre d''integrales prises simultanement'
     *      ,' est inferieur a 100    augmenter iadris'
               print*,'naa1',naa1
c            stop
         endif
         itest(48)=max(itest(48),naa)
c         call verdim('dans cdrs1 naa1 trop petit naa max',naa,
c     *   iadris-iadristp-maxsps*3)
         call cdrs3(ind256,aa,iespaa(iiaa),coef(8*naa1+1)
     *   ,naa1,naa,iaa,ncc,a,b
     *   ,jcas,file,y66)
 75      continue
      enddo
      close(51)
      return
      end
       subroutine cdrs2(iespaa,coef,aa,naa,naa1,
     *iaa,ncc,esp1,jcas,file,y66,ind256)
      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 /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      dimension esp1(iadri)
      character*1 syspin
      common/sysp1/syspin
      common /icd1/ispin(2)
      common/dimis/ iadris,iadristp,maxsps
      dimension aa(naa1),iespaa(iadris-naa1*3),coef(naa1,ind256)
      character*1 coef
      common/test/itest(100)
      common/pr/nprint,mprint(10)
      common/naadi/naadim
      yw=nprint.ge.3
      yw1=nprint.ge.3
      yjnel=file(1:7).eq.'CDI_211'.and.jcas.eq.1
      yjeql=file(1:7).eq.'CDI_211'.and.jcas.eq.2
c     boucles sur les indices CAS
      if(yw)print*,'entree cdrs2 ncc,naa,naa1,jcas',ncc,naa,naa1,jcas
      if(yw)print*,'yjeql,yjnel',yjeql,yjnel
c        boucles sur la partie non CAS
      nbaa=(naa-1)/naa1+1
c      if(naa.ne.naa1)print*,'cdrs2 naa,naa1,nbaa',naa,naa1,nbaa
      itest(54)=max(itest(54),nbaa)
      if(norb.lt.256) then
         iiaa2=naa1*3
      else
         iiaa2=naa1*13/4
      endif
c===============================================
c     boucle sur le nombre de blocs d'integrales
c===============================================
      do kaanb=1,nbaa
         if(kaanb.lt.nbaa) then
            naaf=naa1
         else
            naaf=naa-naa1*(kaanb-1)
         endif
         if(yw)print*,'kaanb,nbaa,naaf',kaanb,nbaa,naaf
         naag=0
         yprem=.true.
c=========================================
c        boucle sur les integrales du bloc
c        on note les indices et les int.
c        (coef et aa)
c=========================================
         do kaa=1,naaf
c           integrale suivante :
            iaa=iaa+1
            if(iaa.gt.1024) then
               iaa=1
               call flush(6)
               call lirin4(inti,intj,intk,intl,aaint,51)
            endif
            if(yw)print*,'cdrs2 int',inti(iaa),
     *      intj(iaa),intk(iaa),intl(iaa),
     *      aaint(iaa)
            if(yjnel) then
c               print*,'lect yjnel'
               if(intj(iaa).eq.intl(iaa)) goto 15
            endif
            if(yjeql) then
               if(intj(iaa).ne.intl(iaa)) goto 15
c               print*,'lect yjeql'
            endif
            naag=naag+1
c           print*,'apres lirin4'
            aa(naag)=aaint(iaa)
c            coef(naag,1)=char(inti(iaa))
c            coef(naag,2)=char(intj(iaa))
c            coef(naag,3)=char(intk(iaa))
c            coef(naag,4)=char(intl(iaa))
            call encod(inti(iaa),intj(iaa),intk(iaa),intl(iaa),
     *      coef(naag,1),coef(naag,2),coef(naag,3),coef(naag,4),
     *      coef(naag,ind256),4)
            if(yprem) then
               yprem=.false.
               in=inti(iaa)
               jn=intj(iaa)
               kn=intk(iaa)
               ln=intl(iaa)
            endif
c            if(yw)write(6,'(a15,4i3,f10.6,i8)')'cdrs2 int',
c     *      inti(iaa),intj(iaa),intk(iaa),intl(iaa),aa(naag)
c            if(yw)write(6,'(a15,5i3,f10.6,i8)')'Cdrs2 int',
c     *      icar(coef(naag,1)),icar(coef(naag,2)),icar(coef(naag,3))
c     *      ,icar(coef(naag,4)),naag
 15         continue
         enddo
         if(naag.eq.0) goto 16
         if(yw) then
         do kaa=1,naag
            write(6,'(a15,4i3,f10.6,i8)')'Cdrs2 int',
     *      icar(coef(kaa,1)),icar(coef(kaa,2)),icar(coef(kaa,3))
     *      ,icar(coef(kaa,4)),aa(kaa)
         enddo
         endif
         if(file(3:3).eq.'I') then
            ispin(1)=1
            ispin(2)=-1
            ymulti=file(1:7).ne.'CDI_211'.or.y66
            if(syspin.eq.'0') then
               call cd02s(in,jn,kn,ln,esp1,naag,file,1,2,3,4
     *         ,iadris-iiaa2,iespaa,coef,aa,ind256)
               if(in.ne.kn.and.jn.ne.ln.and.ymulti) then
                  call cd02s(in,ln,kn,jn,esp1,naag,file,1,4,3,2
     *            ,iadris-iiaa2,iespaa,coef,aa,ind256)
               endif
               if(ln.ne.kn.or.in.ne.jn) then
                  if(in.ne.ln.or.jn.ne.kn) then
                     call cd02s(jn,in,ln,kn,esp1,naag,file
     *               ,2,1,4,3,iadris-iiaa2,iespaa,coef,aa,ind256)
                     if(in.ne.kn.and.jn.ne.ln.and.ymulti) then
                        call cd02s(jn,kn,ln,in,esp1,naag,file
     *                  ,2,3,4,1,iadris-iiaa2,iespaa,coef,aa,ind256)
                     endif
                  endif
               endif
            else
               if(in.eq.jn.and.kn.eq.ln) then
                  do k=1,naa
                     aa(k)=aa(k)/2
                  enddo
               endif
               call cd02s(in,jn,kn,ln,esp1,naag,file,1,2,3,4
     *         ,iadris-iiaa2,iespaa,coef,aa,ind256)
c               if(in.ne.kn.and.jn.ne.ln.and.file(1:7).ne.'CDI_211')
               if(in.ne.kn.and.jn.ne.ln)
     *         call cd02s(kn,jn,in,ln,esp1,naag,file,3,2,1,4
     *         ,iadris-iiaa2,iespaa,coef,aa,ind256)
            endif
         else
            if(syspin.eq.'0') then
               ideb=0
            else
               ideb=2
            endif
            do ispint=ideb,2,2
               if(ispint.eq.0) then
                  ispin(1)=-1
                  ispin(2)=-1
               else
                  ispin(1)=1
                  ispin(2)=1
               endif
               intsgn=1
               if(yw1)write(6,'(a20,4i3,f12.8)')
     *         'int avec echange ',in,jn,kn,ln,aa(1)
c               call cd02s(jn,in,ln,kn,esp1,naag,file,2,1,4,3
               call cd02s(in,jn,kn,ln,esp1,naag,file,1,2,3,4
     *         ,iadris-iiaa2,iespaa,coef,aa,ind256)
            enddo
         endif
 16      continue
      enddo
c      enddo
      return
      end
       subroutine cdrs3(ind256,aa,iespaa,coef,naa1,naa,iaa,ncc,a,b
     *,jcas,file,y66)
      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,ind256)
      character*1 coef
      common/naadi/naadim
      common/pr/nprint,mprint(10)
      common/test/itest(100)
      yw=.false.
      yw1=nprint.ge.2
      if(yw)print*,'entree cdrs3 file,naa ',file,naa
      if(naa.eq.0) return
c     boucles sur les indices CAS
      if(itest(49).ne.0) naa1=min(naa1,itest(49))
      naadim=naa1
      y66=.false.
      do icc=1,ncc
            iaa0=iaa
            call cdrs2(iespaa,coef,aa,naa,naa1,
     *      iaa,ncc,a,jcas,file,y66,ind256)
      enddo
      return
      end
