      subroutine splitpqrs
      use module
      use mod_tijkl
      use mod_licost
      implicit real*8 (a-h,o-x,z),logical*1(y)
      integer(8) tot_size
      character(13) filename1
      integer(2) idx4(4,4096)
      character(30) c
!
!****************ATTENTION**************
! idx dans Q5  idx(4096,2)       modifier q52casdi
!***************************************
 
      dimension value(4096),num_file(36,8)
      integer(2),allocatable,dimension(:,:,:) :: jdx4
      real(8),allocatable,dimension(:,:) :: value2
      yw=.false.
      call cpu_time(t0)
!
!--------------------------------
! Dimensions of pqrs temp files
!--------------------------------
!
      if(yw)print*,'isymoa',isymoa(1:nsym)
      !print*,'itsymoa',itsymoa
 
      nb_typ_int=0
      do is=1,nsym
         do js=1,is
            if(is==js) then
               nijs=num1(isymoa(is)+1)
            else
               nijs=isymoa(is)*isymoa(js)
            endif
            ijs=its(is,js)
            do ks=1,is
               ls=its(ijs,ks)
               if(ls>ks) cycle
               if(is==ks.and.ls>js) cycle
               if(ks==ls) then
                  nkls=num1(isymoa(ks)+1)
               else
                  nkls=isymoa(ks)*isymoa(ls)
               endif
               nb_typ_int=nb_typ_int+1
               num_file(num1(is)+js,ks)=nb_typ_int
               if(is==ks) then
                  nijkls(nb_typ_int)=nijs*(nijs+1)/2
               else
                  nijkls(nb_typ_int)=nijs*nkls
               endif
               ind_aos(nb_typ_int,1)=is
               ind_aos(nb_typ_int,2)=js
               ind_aos(nb_typ_int,3)=ks
               ind_aos(nb_typ_int,4)=ls
               if(nprint>0)
     *         print'(a,i6,2x,4i4,i8)','nijkls',nb_typ_int,is,js,ks,ls
     *         ,nijkls(nb_typ_int)
            enddo
         enddo
      enddo
!
!
! max number of pqrs (as a function of is,js,ks,ls)
      mem=1
      memb=mem*1000000
      !memb=90000
      max_pqrs=maxval(nijkls(1:nb_typ_int))
! total size of the rectangular matrix containing all pqrs
      tot_size=max_pqrs*nb_typ_int
! max size in memory
      max_size=min(memb/16,tot_size)
! max number of pqrs in memory
      max_pqrs_mem=max_size/nb_typ_int
      if(nprint>0)print*,
     *'max_pqrs,tot_size,memb,max_size,max_pqrs_mem,nb_typ_int',
     *max_pqrs,tot_size,memb,max_size,max_pqrs_mem,nb_typ_int
      if(nprint>0)print*,'lblock',lblock
      if(max_pqrs_mem<lblock) then
         print*,'************************************'
         print*,'splitpqrs: max_pqrs_mem<lblock)'
     *   //'lblock is too large'
         print*,'max_pqrs_mem',max_pqrs_mem,'    lblock',lblock
         print*,'************************************'
         stop
      endif
      max_pqrs_mem=(max_pqrs_mem/lblock)*lblock
      if(nprint>0)print*,'max_pqrs_mem',max_pqrs_mem
      allocate(value2(max_pqrs_mem,nb_typ_int))
      allocate(jdx4(4,max_pqrs_mem,nb_typ_int))
!
!---------------------------------------------------
! allocate temp integral vectors, open temp files
!---------------------------------------------------
!
 
      allocate(temp_vect_pqrs(max_size,nb_typ_int))
      filename(:)(:)=' '
      do i_typ_int=1,nb_typ_int
         write(filename(i_typ_int)
     *   ,'(a8,4i1)')'TEMPPQRS',ind_aos(i_typ_int,:)
         if(nprint>0)print*,'Filename'//filename(i_typ_int)//'|||'
         !print*,'pqrs_already_splitted',pqrs_already_splitted
         !print*,'FILE',filename(i_typ_int)
         if(.not.pqrs_already_splitted) then
            open(10,form='unformatted',status='replace',file=
     *      filename(i_typ_int))
            close(10)
         endif
         nbfil_pqrs_s(i_typ_int)=0
      enddo
!
!---------------------------------------------------
! Distribute pqrs on TEMP files
!---------------------------------------------------
!
      if(.not.pqrs_already_splitted) then
         ilec=4096
         iecr=0
         npsrs_s=max_pqrs_mem
         i_file_s=0
         rewind 2
         do
            ilec=ilec+1
            iecr=iecr+1
            if(ilec>4096) then
               read(11) idx4,value
               ilec=1
            endif
            i=max(idx4(1,ilec),idx4(2,ilec))
            j=min(idx4(1,ilec),idx4(2,ilec))
            k=max(idx4(3,ilec),idx4(4,ilec))
            l=min(idx4(3,ilec),idx4(4,ilec))
            if(yw)print'(a,4i4,f12.8)','splitpqrs Integrale lue'
            if(i==0) exit
            is=itsymoa(i)
            js=itsymoa(j)
            ks=itsymoa(k)
            ls=itsymoa(l)
            i_typ_int=num_file(num1(is)+js,ks)
            npqrs_s(i_typ_int)=npqrs_s(i_typ_int)+1
!            print*,'npqrs_s(i_typ_int)',i_typ_int,npqrs_s(i_typ_int),
!        *   max_pqrs_mem
            n=npqrs_s(i_typ_int)
            jdx4(1,n,i_typ_int)=i
            jdx4(2,n,i_typ_int)=j
            jdx4(3,n,i_typ_int)=k
            jdx4(4,n,i_typ_int)=l
            value2(n,i_typ_int)=value(ilec)
            if(yw)print'(a,4i4,f12.8,2i8)',
     *      'pqrs  ',i,j,k,l,value2(n,i_typ_int)
     *      ,npqrs_s(i_typ_int),max_pqrs_mem
            if(npqrs_s(i_typ_int)==max_pqrs_mem) then
               long=(max_pqrs_mem/lblock)*lblock
               if(.not.pqrs_already_splitted)
     *         call wpqrs(filename(i_typ_int),jdx4(:,:,i_typ_int),
     *         value2(:,i_typ_int),long,lblock)
               npqrs_s(i_typ_int)=mod(max_pqrs_mem,lblock)
               nbfil_pqrs_s(i_typ_int)=nbfil_pqrs_s(i_typ_int)+1
            endif
         enddo
      
!      print*,'fin_ecr'
! write last record
         do i_typ_int=1,nb_typ_int
            npqrs_s(i_typ_int)=npqrs_s(i_typ_int)+1
            n=npqrs_s(i_typ_int)
            jdx4(1,n,i_typ_int)=0
            jdx4(2,n,i_typ_int)=0
            jdx4(3,n,i_typ_int)=0
            jdx4(4,n,i_typ_int)=0
            value2(n,i_typ_int)=0.d0
            long=mod(npqrs_s(i_typ_int),max_pqrs_mem)
            if(long==0) long=max_pqrs_mem
            if(.not.pqrs_already_splitted)
     *      call wpqrs(filename(i_typ_int),jdx4(:,:,i_typ_int),
     *      value2(:,i_typ_int),long,lblock)
            nbfil_pqrs_s(i_typ_int)=nbfil_pqrs_s(i_typ_int)+1
         enddo
         open(99,file='TEMPPQRS_INFO',status='unknown',
     *   form='unformatted')
         write(99) nbfil_pqrs_s,npqrs_s
         close(99)
      else
! Files PQRSTEMP exist, read info to read them
         open(99,file='TEMPPQRS_INFO',status='old',
     *   form='unformatted')
         read(99) nbfil_pqrs_s,npqrs_s
         close(99)
      endif
      deallocate(jdx4,value2)
      call cpu_time(t1)
      write(c,'(a,f15.6,a)')'cpu time ',t1-t0,' sec'
      print'(a)','End splitting pqrs in symmetries    '//trim(c)
      print*,' '
      print*,' '
      close(11)
      return
      end
 
       subroutine wpqrs(file,jdx,value,long,lblock)
      character(*) file
      integer(2) jdx(4,long),zero
      real(8) value(long)
      logical yw
      yw=.false.
      zero=0
      open(10,form='unformatted',status='old',file=file)
      do
         read(10,end=10)
      enddo
 10   continue
      nbrec=long/lblock
      if(yw)print*,'nbrec',nbrec,long,lblock
      if(mod(long,lblock)/=0) nbrec=nbrec+1
      ifin=0
      do irec=1,nbrec
         ideb=ifin+1
         ifin=ifin+lblock
         if(ifin>long) then
            !print*,'ecriture 10 (1)',ideb,ifin,long
            write(10) jdx(:,ideb:long),(zero,k=1,(ifin-long)*4)
     *      ,value(ideb:long),(0.d0,k=1,ifin-long)
            if(yw) then
                if(yw)print'(a,4i4,f10.6,i7)','dwpqrs',jdx(:,ideb)
     *          ,value(ideb),ideb
                if(yw)print'(a,4i4,f10.6,i7)','fwpqrs',jdx(:,long)
     *          ,value(long),long
!               do kk=ideb,long
!                  print'(a,4i4,f10.6,i7)','wpqrs',jdx(:,kk),value(kk),kk
!               enddo
            endif
         else
            !print*,'ecriture 10 (2)',ideb,ifin
            write(10) jdx(:,ideb:ifin),value(ideb:ifin)
            if(yw) then
                if(yw)print'(a,4i4,f10.6,i7)','dwpqrs',jdx(:,ideb)
     *          ,value(ideb),ideb
                if(yw)print'(a,4i4,f10.6,i7)','fwpqrs',jdx(:,ifin)
     *          ,value(ifin),ifin
!               do kk=ideb,ifin
!                  print'(a,4i4,f10.6,i7)','wpqrs',jdx(:,kk),value(kk),kk
!               enddo
            endif
         endif
      enddo
      close(10)
      return
      end
