      subroutine fai3ijcl4
      use mod_casdint
      IMPLICIT REAL*8(A-H,O-x,z),logical*1(y)
      integer(2),dimension(4096) :: iint,jnt,knt,lnt
      allocatable aijkli(:),iadrijkli(:)
      dimension aa(3,4096)
      integer :: sto_point
!
!---------------------------------------------------------
! On alloue un tableau pouvant contenir le plus grand des
! fichiers d'integrales
!---------------------------------------------------------
!
      yw=.false.
      mm=maxval(max_stolong)
      if(yw)print*,'mm',mm
      allocate(aijkli(mm))
      allocate(iadrijkli(mm))
      call titre('Stockage des integrales a 4 indices#',40)
!
!--------------------------------------------------
! on lit les fichiers d'integrales un a un
! (1 fichier par 1er indice de l'integrale)
!--------------------------------------------------
!
      open(11,form='unformatted',file=ijcl41,status='unknown')
      call filesplit('OPEN',11,maxlong_modif,idum,idum2)
      call filesplit('WRITE',11,4,ichange,idum2)
      write(11) maxlong_modif
      n=0
      do i1=4,norb
!
! On remplit le tableau d'integrales aijkli
!
         open(10,form='unformatted',file=stoname(i1),status='old',
     *   access='DIRECT',recl=max_stoind*12)
         ifin=0
         do sto_point=1,sto_pointer(i1)
            ideb=ifin+1
            ifin=ifin+max_stoind
            ifin=min(ifin,max_stolong(i1))
            if(ifin<ideb) exit
            if(yw)print*,'i1,ideb,ifin',i1,ideb,ifin,max_stolong(i1),
     *      sto_point
            read(10,rec=sto_point) iadrijkli(ideb:ifin),
     *      (aijkli(iadrijkli(k)),k=ideb,ifin)
         enddo
 1       continue
         if(yw)print*,'i1,ifin',i1,ifin
         do k=1,ifin
            if(yw)print*,'INTlu',i1,k,iadrijkli(k),aijkli(k)
         enddo
         is=itsym(i1)
!
! On genere les int dans l'ordre de leurs adresses
!
         m=0
         do js=1,is
            do ks=1,js
               ls=its(is,its(js,ks))
               if(ls>ks) cycle
               idebj=ntstot(js-1)+1
               if(is==js) then
                  ifinj=i1-1
               else
                  ifinj=ntstot(js)
               endif
               do j1=idebj,ifinj
                  idebk=ntstot(ks-1)+1
                  if(js==ks) then
                     ifink=j1-1
                  else
                     ifink=ntstot(ks)
                  endif
                  !if(is==ks) ifink=min(i1-1,ifink)
                  do k1=idebk,ifink
                     idebl=ntstot(ls-1)+1
                     if(ks==ls) then
                        ifinl=k1-1
                     else
                        ifinl=ntstot(ls)
                     endif
                     do l1=idebl,ifinl
                        n=n+1
                        if(n>4096) then
                           call filesplit('WRITE',11,131072,
     *                     ichange,idum2)
                           write(11)iint,jnt,knt,lnt,aa
                           n=1
                        endif
                        m=m+1
! passage aux indices numerotes comme en lecture
                        i=iord(i1)
                        j=iord(j1)
                        k=iord(k1)
                        l=iord(l1)   
! on reordonne i>j>k>l               
                        call reori   cas2(i,j,k,l)
! on stocke
                        iint(n)=i
                        jnt(n)=j
                        knt(n)=k
                        lnt(n)=l
                        aa(1,n)=aijkli(m)
                        m=m+1
                        aa(2,n)=aijkli(m)
                        m=m+1
                        aa(3,n)=aijkli(m)
                        if(yw)print'(''INT '',4i4,3f12.8,4i4,4x,4i4)',
     *                  i1,j1,k1,l1,aa(:,n),is,js,ks,ls,i,j,k,l
                     enddo
                  enddo
               enddo
            enddo
         enddo
         close(10,status='delete')
         if(yw)print*,'destruction  ',stoname(i1)
      enddo
      n=n+1
      if(n>4096) then
         call filesplit('WRITE',11,131072,ichange,idum2)
         write(11)iint,jnt,knt,lnt,aa
         n=1
      endif
      iint(n)=0
      jnt(n)=0
      knt(n)=0
      lnt(n)=0
      aa(:,n)=0.d0
      call filesplit('WRITE',11,131072,ichange,idum2)
      write(11)iint,jnt,knt,lnt,aa
      close(11)
      return
      end
