      subroutine prepad
      use mod_casdint
      use mod_script
      character(100000) namel
      character(4) c
      integer(8) mem2,mbid
      logical yw
      allocate(stoname(4:norb))
      allocate(sto_pointer(4:norb))
      yw=.false.
      if(yw)print*,'entree prepad'
!
!------------------------------
! Allocations
!------------------------------
!
      allocate(ajk(norb,norb),aijjj(norb,norb))
!
!----------------------------------------------------------
! lecture de its
!----------------------------------------------------------
!
      open(1,file=info1,status='old')
      call LECNAM('&COST_AO',namel,1,ierr,1)
      call nameli(namel,ITS,'ITS',4)
!
!--------------------------------------------------
! Constantes jad2 et jad3, pour les combinaisons
!--------------------------------------------------
!
      allocate(jad3(norb),jad2(norb))
      do k=1,norb
         jad3(k)=(k-1)*(k-2)*(k-3)/6
         jad2(k)=(k-1)*(k-2)/2
      enddo
!
!----------------------------------------------------------
! On reordonnera les indices dans l'ordre des symetries
!----------------------------------------------------------
!
      allocate(iord(norb))
      allocate(inv_iord(norb))
      i=0
      do is=1,nsym
         do k=1,norb
            if(itsym(k)/=is) cycle
            i=i+1
            iord(i)=k
            inv_iord(k)=i
         enddo
      enddo
      if(yw) then
         print'(a,50i3)','iord',iord
         do k=1,norb
            print*,'iord inv_iord',k,iord(k),inv_iord(k)
         enddo
         do k=1,norb
            print*,'itsym vieux',k,itsym(k)
         enddo
      endif
      itsym(:)=itsym(iord(:))
      if(yw) then
         do k=1,norb
            print*,'itsym nouveau',k,itsym(k)
         enddo
      endif
!
!----------------------------------------------------------
! Numero des orbitales dans leur symetrie
! nombre d'integrales / sym
!----------------------------------------------------------
!
      allocate(io(norb))
      nts=0
      do k=1,norb
         nts(itsym(k))=nts(itsym(k))+1
         io(k)=nts(itsym(k))
      enddo
      if(yw) then
         do k=1,norb
            print*,'sym,io',k,itsym(k),io(k)
         enddo
         print*,'nts',nts(1:nsym)
      endif
      ntstot(0)=0
      do is=1,nsym
         ntstot(is)=ntstot(is-1)+nts(is)
      enddo
!
!--------------------------------------------------------------
! integrales a 4 indices
! calcul du nombre d'integrales par classe i,js,ks,ls (iadr0)
! calcul de iadr0 (nombre d'adresses d'integrales avant la classe)
!--------------------------------------------------------------
!
      allocate(iadr0(4:norb,nsym,nsym))
      allocate(max_stolong(4:norb))
      max_stolong=0
      do i=4,norb
         n=0
         is=itsym(i)
         do js=1,is
            do ks=1,js
               ls=its(is,its(js,ks))
               if(ls>ks) cycle
               iadr0(i,js,ks)=n
               if(is==js) then
                  if(is==ks) then
! is=js=ks=ls
                     n=jad3(io(i))+n
                  else
! is=js>ks=ls
! j varie de 1 a i-1, dim(k,l)=jad2(nts(ks)+1)
                     n=(io(i)-1)*jad2(nts(ks)+1)+n
                  endif
               else
                  if(is==ks) then
! is>js=ks>ls
! dim(j,k)=jad2(nts(js)+1),  l varie de 1 a nts(ls)
                     n=nts(ls)*jad2(nts(js)+2)+n
                  else
! is>js>ks>ls, 
                     n=nts(js)*nts(ks)*nts(ls)+n
                  endif
               endif
               if(yw)print'(a,10i5)','iadr0',i,js,ks,ls,n,iadr0(i,js,ks)
            enddo
            max_stolong(i)=max(max_stolong(i),n)
         enddo
         if(yw)print*,'n,max_stolong',n,max_stolong(i),i
      enddo
      max_stolong=max_stolong*3
      mmax_stolong=maxval(max_stolong)
!
!--------------------------------------------------------------
! integrales a 3 indices
! calcul du nombre d'integrales par classe is,js, (iadr03)
!--------------------------------------------------------------
!
      allocate(iadr03(nsym,nsym))
      do is=1,nsym
         n=0
         if(nts(is)==0) cycle
         do js=1,nsym
            if(nts(js)==0) cycle
            iadr03(is,js)=n
            if(is==js) then
               n=nts(is)*jad2(nts(js))+n
            else
               n=nts(is)*jad2(nts(js)+1)+n
            endif
            if(yw)print'(a,10i5)','iadr03',is,js,n,iadr03(is,js)
     *      ,nts(is),nts(js),jad2(nts(js)),jad2(nts(js)+1)
         enddo
         max_stolong3(is)=n
         print*,'n,max_stolong3(is),is',n,max_stolong3(is)*2,is
      enddo
      max_stolong3(:)=max_stolong3(:)*2
      mmax_stolong3=maxval(max_stolong3(:))
!
!----------------------------------------------------------
! allocation des premiers tableaux d'integrales
!----------------------------------------------------------
!
      call titre('prepad :#allocation '//
     *'des premiers tableaux d''integrales#',40)
      mem2=mem
      mem2=mem2*1000000
      mbid=norb-3
      mem2=mem2/mbid
      print*,'memoire disponible :',mem,' Mb'
      write(75,*)'On a ',norb,'orbitales, donc,'//
     *' par fichier ',mem2,' bytes$'
      call scril
      print*,'On veut stocker un entier 4 et un reel 8, donc 12 bytes'
      write(75,*)'La dimension max est donc ',mem2,'/12 =',mem2/12,'$'
      call scril
      print*,'le nb max d''int pour tous les indices'//
     *' est',mmax_stolong
      if(mmax_stolong<=mem2/12) then
         print*,'Toutes les integrales tiennent en memoire'
      else
         print*,'Il faudra stocker sur disque les integrales'
      endif
      max_stoind=mem2/12
      max_stoind=min(max_stoind,mmax_stolong)
      allocate(stoint(max_stoind,4:norb))
      allocate(stoint3(4096,nsym))
      allocate(stoad(max_stoind,4:norb))
      allocate(stoad3(4096,nsym))
      !allocate(stoind(4:norb))
      allocate(ninti(4:norb+nsym))
      ninti=0
      write(75,*)'allocation du gros tableau : stoint('
     *,max_stoind,',4:norb)$'
      call scril
!
!----------------------------------------------------------
! ouverture des premiers fichiers d'integrales
!----------------------------------------------------------
!
      do k=4,norb
         write(c,'(i4)') k
         do l=1,3
            if(c(l:l)==' ') c(l:l)='0'
         enddo
         !open(99,form='unformatted',file='STO1_'//c,status='unknown')
         !close(99,status='delete')
         !open(99,form='unformatted',file='STO1_'//c,status='unknown')
         open(99,form='unformatted',file='STO1_'//c,status='unknown',
     *   access='DIRECT',recl=max_stoind*12)
         stoname(k)='STO1_'//c
         sto_pointer(k)=0
         if(yw)print*,'maz3  ','STO1_'//c,3-k/10
         close(99)
      enddo
!
!----------------------------------------------------------
! ouverture des fichiers pour int a 3 indices
!----------------------------------------------------------
!
      do is=1,nsym
         write(c(1:1),'(i1)') is
         open(11+is,file='STO1_IND3'//c(1:1),
     *   form='unformatted',status='unknown')
      enddo
      return
      end

