      subroutine tijkl
!
!-----------------------------------------------------------------------
! 1. preliminary calculations
!
! 2. split integral file into files according to the symmetry of the
!    indices (files TEMPPQRSijkl, i,j,k,l=index symmetries
!    1111, 2121, 2211 ...)
!
!    outer loop on index symmetrie ijkl
!
! 3. read TEMPPQRSijkl
!    scope: split file into smaller files that can fit in memory
!    all pqrs integrals corresponding to a given pq pair must
!    belong to only one file
!
!    compute the number of integrals corresponding to a pq pair
!    compute the number of pq pairs that fit in a file
!    compute the number Nfil of required files, open them
!    put in memory a 2x2 matrix:  (p,q) --> Nr of the file
!    Allocate a buffer table B(d,Nfil), with d as large as possible
!
! 4. read TEMPPQRSijkl, fill B, write lines to file TEMPPQRSijkl_m
!    m=1,Nf when they are full
!
!
! VARIABLES
!
! Atomic orbitals:
! noa               : number of atomic orbitals
! isymoa(is)        : number of atomic orbitals for symmetry is
! isymoat(is)       : sum(isymoa(1:is-1)
! insoa(i)          : rank of AO i in its symmetry
! msymoa            : maxval(isymoa(1:nsym))
! itsymoa(i)        : symmetry of AO i
!
! Molecular orbitals:
! norb              : number of molecular orbitals
! isym(is)          : number of molecular orbitals for symmetry is
! isymt(is)         : sum(isym(1:is-1)
! ins(i)            : rank of MO i in its symmetry
! msym              : maxval(isym(1:nsym))
! itsym(i)          : symmetry of MO i
!
! Semi-active calculation:
! noac              : number of active orbitals
! numac(k)          : absolute rank of kth active
!                    (absolute rank = rank in the full list of MO's)
! numnonac(k)       : absolute rank of kth non active
! insac(active MO)  : rank of the active orb in the list of the actives
!                     of its symmetry
! insac(non act MO) : idem for non active orb
! yac(i)            :T if MO i is active
! noacs(is)         : number of active orbitals in symmetry is
! nononacs(is)      : number of non active orbitals in symmetry is
! numacs(a,is)      : rank of active a in the list of MO's
!                     in its symmetry
! numnonacs(na,is)  : rank of non active na in the list of MO's
!                     in its symmetry
! insinv(no)        : no is the rank of orb o in the list ordered
!                     by symmetry
!                     insinv(no) is its rank in the list ordered
!                     occ_sym1,virt_sym1,occ_sym2,virt_sym2...
!
!-----------------------------------------------------------------------
!
      use module
      use mod_script
      use mod_licost
      use mod_tijkl
      use mod_sto
      implicit real*8 (a-h,o-x,z),logical*1(y)
      dimension norsy(8)
      real(8),allocatable,dimension(:,:) :: p1,p2,p3!
      yw1=.false.
!
! STEP 1
!
      yw=.false.
      yw=yw.or.ywtot
      yw2=.false.
      allocate(num1(noa+1))
      allocate(num2(noa+1))
      allocate(num3(noa+1))
      allocate(insoa(noa))
      allocate(ins(norb))
      allocate(insac(norb))
      msymoa=maxval(isymoa(1:nsym))
      allocate(p1(msymoa,msymoa),p2(msymoa,msymoa),p3(msymoa,msymoa))
!      allocate(temp(norb))
!      allocate(ylech(maxval(isymoa)))
      do k=1,noa+1
         num1(k)=k*(k-1)/2
         num2(k)=(k+1)*k*(k-1)/6
         num3(k)=(k+2)*num2(k)/4
      enddo
      do k=1,nsym
         isymt(k)=sum(isym(1:k-1))
         isymtoa(k)=sum(isymoa(1:k-1))
      enddo
!
! Indices of orbitals in symmetries
! insoa: rank of AO in its symmetry
! ins: rank of MO in its symmetry
! insac(active MO): rank of the active orb in the list of the actives
! of its symmetry
! insac(non active MO): idem for non active orb
!
      allocate(itsymoa(noa))
      nn=0
      do is=1,nsym
         do i=1,isymoa(is)
            nn=nn+1
            itsymoa(nn)=is
         enddo
      enddo
      norsy=0
      do k=1,noa
         is=itsymoa(k)
         norsy(is)=norsy(is)+1
         insoa(k)=norsy(is)
      enddo
      norsy=0
      do k=1,norb
         is=itsym(k)
         norsy(is)=norsy(is)+1
         ins(k)=norsy(is)
      enddo
      if(noac==0) then
         insac=ins
      else
         norsy=0
         do k=1,norb
            is=itsym(k)
            if(.not.yac(k)) then
               norsy(is)=norsy(is)+1
               insac(k)=norsy(is)
            endif
         enddo
         norsy=0
         do k=1,norb
            is=itsym(k)
            if(yac(k)) then
               norsy(is)=norsy(is)+1
               insac(k)=norsy(is)
            endif
         enddo
      endif
      if(yw)print*,'insoa'
      if(yw)print'(10i5)',insoa(1:noa)
      if(yw)print*,'ins'
      if(yw)print'(10i5)',ins(1:norb)
      if(yw)print*,'insac'
      if(yw)print'(10i5)',insac(1:norb)
!
! transformation matrix
!
      msym=maxval(isym(1:nsym))
      allocate(om(msymoa,msym,nsym))
      allocate(om1(msymoa,msym))
      allocate(om2(msymoa,msym))
      allocate(om3(msymoa,msym))
      allocate(om4(msymoa,msym))
      allocate(numom1(msym))
      allocate(numom2(msym))
      allocate(numom3(msym))
      allocate(numom4(msym))
!      allocate(numadr2(norb))
!      allocate(numadr3(noa))
!      allocate(numadr4(noa))
      
! read the orbitals
      rewind 33
      do is=1,nsym
         n=isym(is)
         !if(n==0) cycle
         read(33) om(1:isymoa(is),1:n,is)
         if(yw)print*,'ijkl om sym',is
         if(yw) call mscript(om(1:isymoa(is),1:n,is))
      enddo
!
! Variables for semi-active calculation
!
      if(semi_active) then
         allocate(noacs(nsym))
         allocate(numacs(maxorbcas,nsym))
         allocate(nononacs(nsym))
         allocate(numnonacs(msym,nsym))
         allocate(numnonac(norb))
         noacs=0
         nononacs=0
         nononac=0
         if(yw)print'(a,40l1)','yac ',yac
         if(yw)print'(a,40i4)','numac ',numac(1:noac)
         if(yw)print'(a,40i4)','itsym ',itsym(1:norb)
         do k=1,norb
            is=itsym(k)
            if(yac(k)) then
               noacs(is)=noacs(is)+1
               numacs(noacs(is),is)=k-isymt(is)
               if(yw)print*,'numacs',noacs(is),is,k
            else
               nononacs(is)=nononacs(is)+1
               nononac=nononac+1
               numnonacs(nononacs(is),is)=k-isymt(is)
               if(yw)print*,'numnonacs',nononacs(is),is,k
               numnonac(nononac)=k
            endif
         enddo
         if(yw)print*,'numacs'
         if(yw)call mscript(numacs)
         if(yw)print*,'numnonacs'
         if(yw)call mscript(numnonacs)
      endif
!
! STEP 2
! Split pqrs file into TEMPPQRSijkl, according to symmetries of i,j,k,l
!
      call splitpqrs
!
! Loop on integral symmetries
!
      call titre('MO Transformation#',50)
! If semi_active calculation, perform transformation in tijkl_sa
      if(semi_active) then
         call tijkl_sa
         !if(ydelf) close(11,status='delete')
      else
         do i_typ_int=1,nb_typ_int
            call cpu_time(t0)
            if(yw)print'(a,i4,3x,4i4)',
     *      'I_TYP_INT',i_typ_int,ind_aos(i_typ_int,:)
            is=ind_aos(i_typ_int,1)
            js=ind_aos(i_typ_int,2)
            ks=ind_aos(i_typ_int,3)
            ls=ind_aos(i_typ_int,4)
            if(isym(is)==0) cycle
            if(isym(js)==0) cycle
            if(isym(ks)==0) cycle
            if(isym(ls)==0) cycle
! Preparing information for subroutines to be called
            om1(1:isymoa(is),1:isym(is))=om(1:isymoa(is),1:isym(is),is)
            om2(1:isymoa(js),1:isym(js))=om(1:isymoa(js),1:isym(js),js)
            om3(1:isymoa(ks),1:isym(ks))=om(1:isymoa(ks),1:isym(ks),ks)
            om4(1:isymoa(ls),1:isym(ls))=om(1:isymoa(ls),1:isym(ls),ls)
            isym1=isym(is)
            isym2=isym(js)
            isym3=isym(ks)
            isym4=isym(ls)
            numom1(1:isym(is))=insinv((/(m,m=1,isym(is))/)+isymt(is))
            numom2(1:isym(js))=insinv((/(m,m=1,isym(js))/)+isymt(js))
            numom3(1:isym(ks))=insinv((/(m,m=1,isym(ks))/)+isymt(ks))
            numom4(1:isym(ls))=insinv((/(m,m=1,isym(ls))/)+isymt(ls))
            if(is==js) then
               n_pspq=num1(isymoa(is)+1)
               n_psrs=num1(isymoa(ks)+1)
               n_psij=num1(isym1+1)
               n_pskl=num1(isym3+1)
            else
               n_pspq=isymoa(is)*isymoa(js)
               n_psrs=isymoa(ks)*isymoa(ls)
               n_psij=isym1*isym2
               n_pskl=isym3*isym4
            endif
!
! STEPS 3
!
            call cpu_time(t_reor1)
            call splitpqrs_s(i_typ_int)
!
! STEPS 4
!
            call reorder
            call cpu_time(t_reor2)
            t_reor=t_reor2-t_reor1
!
! Transform
!
            if(ydelf) close(11,status='delete')
            call tra2(i_typ_int,p1,p2,p3)
            call cpu_time(t1)
            print'(a,4i4,3(a,f12.3))','REORDER TRANSF TOT',
     *      is,js,ks,ls,'    cpu',t_reor,' ',t_transf,' ',t1-t0
            if(ydelf) close(11,status='delete')
         enddo
!         do i_typ_int=1,nb_typ_int
!            open(11,form='unformatted',status='old',
!     *      file=filename(i_typ_int))
!            close(11,status='delete')
!         enddo
      endif
      if(yw) print*,'avant stoijklf'
      call stoijklf(72)
      deallocate (om)
      if(any(frozen/=0)) then
         call tijklfr
      endif
      deallocate(om1,om2,om3,om4,numom1,numom2,numom3,numom4)
      return
      end
       subroutine tijkl_sa
      use module
      use mod_script
      use mod_licost
      use mod_tijkl
      use mod_sto
!
!------------------------------------------------------------
! semi_active integrals, to perform loccascf 
!
! Cele 
!   1      J(i,j) and K(i,j) integrals, two core indices  
!          (iijj)   (ijij)
!   2      Two active and two core (equal) indices
!          (iiab)    (iaib)
!   3      J(i,j) and K(i,j) integrals, one core a one virtual indices
!          (iivv)   (iviv)
!   4      Two active and two virtual (equal) indices
!          (abvv)   (avbv)
!   5      Four active indices
!          (abcd)
!   6      One virtual and three core (2 equal) indices
!          (ijjv)   (iijv)
!   7      One virtual, two active and one core indices
!          (abiv)   (aibv)
!   8      One virtual, one active and two core (equal) indices
!          (iiav)   (iaiv)
!   9      One virtual, three active indices
!          (abcv)
!  10      One active and three core (2 equal) indices
!          (iija)   (iaij)
!  11      One core, three active indices
!          (iabc)
!--------------------------------------------------------------
!
!--------------------------------------------------------------
! pqrs                   | iirs  x4 | iqis  x2 |
! qprs  p/=q             | iirs   0 | ipis  x2 |
! pqsr  r/=s             | iisr   0 | iqir  x2 |
! qpsr  p/=q r/=s        | iisr   0 | ipir  x2 |
! rspq  pq/=rs           | iipq  x4 | isiq     |
! srpq     "   r/=s      | iipq   0 | iriq     |
! rsqp     "   p/=q      | iiqp   0 | isip     |
! srqp     "   p/=q r/=s | iiqp   0 | irip     |
!----------------------------------------------------------------------
! p==q                                         
! pqrs                   | iirs  x2 | iqis  x2 |
! pqsr                   | iisr   0 | iqir  x2 |
! rspq  pq/=rs           | iipq  x2 | isiq     |
! srpq     "   r/=s      | iipq   0 | iriq     |
!----------------------------------------------------------------------
! q==r                                         
! pqrs                   | iirs  x2 | iqis  x2 |
! qprs  p/=q             | iirs   0 | ipis  x2 |
! rspq                   | iipq  x2 | isiq     |
! rsqp  pq/=rs p/=q      | iiqp   0 | isip     |
!----------------------------------------------------------------------
! pq==rs  (p==r and q==s)                      
! pqrs                   | iirs  x4 | iqis     |
! qprs  p/=q             | iirs   0 | ipis     |
! pqsr  r/=s             | iisr   0 | iqir     |
! qpsr  p/=q r/=s        | iisr   0 | ipir     |
!----------------------------------------------------------------------
! pq==rs p==q                                  
! pqrs                   | iirs  x2 | iqis     |
! pqsr  r/=s             | iisr   0 | iqir     |
!------------------------------------------------------------------------
! pq==rs r==s                                   
! pqrs                   | iirs  x2 | iqis     |
! qprs  p/=q             | iirs   0 | ipis     |
!------------------------------------------------------------------------
! p==q==r==s                                   |
! pqrs                   | iirs     | iqis     |
!----------------------------------------------------------------------

!
      implicit real*8 (a-h,o-x,z),logical*1(y)
      logical yw
      real(8),allocatable,dimension(:,:) :: iirs,iris,abrs
      real(8),allocatable,dimension(:,:,:) :: aqbs
!      real(8),allocatable,dimension(:,:,:) :: aqbsc
      real(8),allocatable,dimension(:,:) :: iirs1,iris1,abrs1,aqbs1
      real(8),allocatable,dimension(:,:) :: aqbs2,a_iijj
      integer(2),dimension(4,lblock) :: jdx4
      real(8),dimension(lblock) :: value2
      integer ip,pq,al,be,ab,pr,qr,al_a,be_a,aal_a,bbe_a,v,v_a,vv_a
      integer ga,ga_a,gga_a,de,de_a,dde_a,cd


      allocatable pqrs(:,:,:,:)

      yw=.false. ; yw=yw.or.ywtot
!
! Loop on integral types
      do i_typ_int=1,nb_typ_int
      !do i_typ_int=2,2
         call cpu_time(t0)
         if(yw)print'(a,i4,3x,4i4)',
     *   'I_TYP_INT',i_typ_int,ind_aos(i_typ_int,:)
         is=ind_aos(i_typ_int,1)
         js=ind_aos(i_typ_int,2)
         ks=ind_aos(i_typ_int,3)
         ls=ind_aos(i_typ_int,4)
         t2=0.d0
         open(11,file=filename(i_typ_int),status='old',
     *   form='unformatted')
! Allocate tables
         allocate(a_iijj(norb,norb))
         a_iijj(:,:)=0.d0
         ii=lblock
         if(is==js) then
            if(is==ks) then
!              is is is is
               call tijkl_saiiii
            else
!              is is ks ks
               call tijkl_saiikk
            endif
         else
            if(is==ks) then
!              is js is js
               call tijkl_saijij
            else
!              is js ks ls
               call tijkl_saijkl
            endif
         endif
         deallocate(a_iijj)
         !call mscript(om1)
         call cpu_time(t1)
         print'(a,4i4,a,f12.3)','REORDER TRANSF TOT',
     *   is,js,ks,ls,'   ',t1-t0
      enddo
      return
      end
C
C
C
C
C
C      subroutine klac
C      use module
C      use mod_script
C      use mod_licost
C      use mod_tijkl
C      use mod_sto
C      isym1=isym(is)
C      isym2=isym(js)
C      isym3=noacs(ks)
C      isym4=noacs(ls)
C      om1(1:isymoa(is),1:isym1)=om(1:isymoa(is),1:isym1,is)
C      om2(1:isymoa(js),1:isym2)=om(1:isymoa(js),1:isym2,js)
C      do k=1,noacs(ks)
C         om3(1:isymoa(ks),k)=om(1:isymoa(ks),ins(numacs(k,ks)),ks)
C      enddo
C      do l=1,noacs(ls)
C         om4(1:isymoa(ls),l)=om(1:isymoa(ls),ins(numacs(l,ls)),ls)
C      enddo
C      numom1(1:isym(is))=insinv((/(m,m=1,isym(is))/)+isymt(is))
C      numom2(1:isym(js))=insinv((/(m,m=1,isym(js))/)+isymt(js))
C      numom3(1:noacs(ks))=insinv(numacs(1:noacs(ks),ks))
C      numom4(1:noacs(ls))=insinv(numacs(1:noacs(ls),ls))
C      if(is==js) then
C         n_pspq=num1(isymoa(is)+1)
C         n_psrs=num1(isymoa(ks)+1)
C         n_psij=num1(isym1+1)
C         n_pskl=num1(isym3+1)
C      else
C         n_pspq=isymoa(is)*isymoa(js)
C         n_psrs=isymoa(ks)*isymoa(ls)
C         n_psij=isym1*isym2
C         n_pskl=isym3*isym4
C      endif
C      return
C      end
C      subroutine klac2
C      use module
C      use mod_script
C      use mod_licost
C      use mod_tijkl
C      use mod_sto
C      isym1=nononacs(is)
C      isym2=noacs(js)
C      isym3=nononacs(ks)
C      isym4=noacs(ls)
C      do i=1,nononacs(is)
C         om1(1:isymoa(is),i)=om(1:isymoa(is),
C     *   ins(numnonacs(i,is)),is)
C      enddo
C      do j=1,noacs(js)
C         om2(1:isymoa(js),j)=om(1:isymoa(js),
C     *   ins(numacs(j,js)),js)
C      enddo
C      do k=1,nononacs(ks)
C         om3(1:isymoa(ks),k)=om(1:isymoa(ks),
C     *   ins(numnonacs(k,ks)),ks)
C      enddo
C      do l=1,noacs(ls)
C         om4(1:isymoa(ls),l)=om(1:isymoa(ls),
C     *   ins(numacs(l,ls)),ls)
C      enddo
C      !print*,'NUMOM1',is,nononacs(is),numnonacs(1:nononacs(is),is)
C      !print*,'NUMOM1',insinv(numnonacs(1:nononacs(is),is))
C      !print*,'NUMOM2',is,noacs(js),numacs(1:noacs(js),js)
C      !print*,'NUMOM2',insinv(numacs(1:noacs(js),js))
C      numom1(1:nononacs(is))=insinv(numnonacs(1:nononacs(is),is))
C      numom2(1:noacs(js))=insinv(numacs(1:noacs(js),js))
C      numom3(1:nononacs(ks))=insinv(numnonacs(1:nononacs(ks),ks))
C      numom4(1:noacs(ls))=insinv(numacs(1:noacs(ls),ls))
C!      numadr2(1:isymoa(js))=(/(m,m=1,isymoa(js))/)
C!      numadr3(1:isym(ks))=(/(m,m=1,isym(ks))/)
C!      numadr4(1:isym(ls))=(/(m,m=1,isymoa(ls))/)
C      if(is==js) then
C         n_pspq=num1(isymoa(is)+1)
C         n_psrs=num1(isymoa(ks)+1)
C         n_psij=num1(isym1+1)
C         n_pskl=num1(isym3+1)
C      else
C         n_pspq=isymoa(is)*isymoa(js)
C         n_psrs=isymoa(ks)*isymoa(ls)
C         n_psij=isym1*isym2
C         n_pskl=isym3*isym4
C      endif
C      !print*,'NPSKL',npskl,isym3,isym4
C      return
C      end
C       subroutine analf(i,comm)
C      character(80) a
C      character(*) comm
C      inquire(i,name=a)
C      print*,trim(comm)
C      print*,'file',i,'  ',trim(a)
C      return
C      end
