      module moddi
      integer,allocatable,dimension(:) :: nequis,num1
      integer(8),allocatable,dimension(:) :: num2,num3
      integer,allocatable,dimension(:,:) :: iequis,iequiloc,incr3k
      character(3),allocatable,dimension(:) :: fich
      integer,allocatable,dimension(:) :: 
     *nint_du_bloc,i_f_cl,rang,nint_par_bloc
     *,num_1er_enr,num_der_enr,app_cl_bloc
     *,nrec_du_bloc
     *,nrec_dela_classe
     *,nint_par_classe1,nint_par_classe2,nint_par_classe
     *,numrec_dela_classe,ifin_dela_classe
     *,incr1,nsym2loc,nloc2sym
     *,incr2,incr3,incr4
      double precision,allocatable,dimension(:,:) :: a_cl
      integer(2),allocatable,dimension(:,:,:) :: ijkl_cl
      allocatable yy(:)
      logical(1) yy
      dimension numrec(1024)
      integer madr1,madr2,madr3,madr4
      character(80) format
      contains
       subroutine calequis
      !
      ! classe des orbitales
      ! nequis(classe)=nb d'orb de la classe
      ! iequis(classe,n)=numero (dans l'odre des sym) de la n.eme orb de
      ! la classe
      ! iequiloc(classe,n)=numero de la n.eme orb locale de la classe
      ! iclasloc(orbitale locale)=classe de l'orbitale
      ! rang(orb)=numero de orb dans sa classe
      !
      
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      allocate (nequis(ncl))
      allocate (iequis(ncl,nsym))
      allocate (iequiloc(ncl,nsym))
      allocate (rang(norb))
      yw=.false.
      nequis=0
         print*,'moddi iclass'
         do k=1,norb
            !print*,'moddi,k,iclas(k)',k,iclas(k)
         enddo
      do icl=1,ncl
         !print*,'moddi icl',icl
         ncl1=0
         do k=1,norb
            if(iclas(k)==icl) then
         !print*,'moddi icl,k,iclas(k)',icl,k,iclas(k)
               nequis(icl)=nequis(icl)+1
         !print*,'moddi icl,nequis(icl)',icl,nequis(icl)
               iequis(icl,nequis(icl))=k
               if(yw)print*,'icl,nequis(icl),iequis',
     *         icl,nequis(icl),iequis(icl,nequis(icl))
               rang(k)=nequis(icl)
            endif
         enddo
      enddo
      j=0
      do icl=1,ncl
         do i=1,nequis(icl)
            j=j+1
            iequiloc(icl,i)=j
            iclasloc(j)=icl
!           rang(j)=i
         enddo
      enddo
      if(yw) then
         do k=1,norb
            print*,'k,rang(k)',k,rang(k)
         enddo
      endif
      print*,'classes         orbitales symetriques'//
     *'            orbitales locales'
      format=' '
      format(1:16)='(i4," ",a," | ",'
      format(18:28)='i4,iix,8i4)'
      ll=maxval(len_trim(tipo_int))
      do icl=1,ncl
         ii=iequis(icl,1)
         if(tipo_int(ii)(1:1)=='T') exit
         write(format(17:17),'(i1)') nequis(icl)
         write(format(21:22),'(i2)') 32-nequis(icl)*4
!         print'(i5,"  ",a,''  |   '',8i4)',icl,tipo_int
         print format ,icl,tipo_int
     *   (iequis(icl,1))(1:ll)
     *   ,iequis(icl,1:nequis(icl)),iequiloc(icl,1:nequis(icl))
         if((nequis(icl)/=1.and.nequis(icl)/=2
     *   .and.nequis(icl)/=4.and.nequis(icl)/=8)
     *   .or.nequis(icl)>nsym) then
            print*,'ERREUR !'
            print*,'l''orbitale ',tipo_int(iequis(icl,1))(1:12)
     *      ,' a la '//
     *      'multiplicite',nequis(icl)
            print*,'la multiplicite peut etre 1,2,4 ou 8 d''une part'//
     *      'et inferieure a nsym d''autre part'
            print*,'ici, nsym=',nsym
            print*,
     *      'Deux orbitales de meme label doivent se correspondre'//
     *      ' par symetrie.' 
         endif
      enddo
      print*,' '
      print*,' '
!      print*,'classes                   orbitales locales'
!      do icl=1,ncl
!         print'(i5,"  ",a,''  |   '',8i4)',icl,tipo_int(
!     *   iequis(icl,1))(1:12),
!     *   iequiloc(icl,1:nequis(icl))
!      enddo
      call flush(6)
      if(yw) then
         do k=1,norb
            print*,'k,iclas(k),iclasloc(k)',k,iclas(k),iclasloc(k)
         enddo
      endif
      return
      end subroutine
       subroutine prepad
      use module
      use modlirin
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      logical val
      integer(8) :: cuatro=4,dos=2
      integer,dimension(4) :: loci
      yw=.false.
      allocate (num1(norb+2))
      allocate (num2(norb+1))
      allocate (num3(norb+1))
      !
      ! Matrices servant a l'adressage
      !
      do k=1,norb
         num1(k)=(k-1)*(k-2)/2
         num2(k)=num1(k)*(k-3)/3
         if(mod(num2(k),cuatro)==0) then
            num3(k)=(num2(k)/4)*(k-4)
         else if(mod(num2(k),dos)==0) then
            num3(k)=(num2(k)/2)*((k-4)/2)
         else
            num3(k)=num2(k)*((k-4)/4)
         endif
         if(yw)print*,'num',num1(k),num2(k),num3(k)
      enddo
      num1(norb+1)=norb*(norb-1)/2
      num1(norb+2)=norb*(norb+1)/2
      norb8=norb
      num3(norb+1)=norb8*(norb8-1)*(norb8-2)*(norb8-3)/24
      num2(norb+1)=norb8*(norb8-1)*(norb8-2)/6

!__!     Test : comptage des integrales
!__      n=0
!__      do i=1,norb
!__         do j=1,i
!__            do k=1,i
!__               if(k==i) then
!__                  do l=1,j
!__                     n=n+1
!__                  enddo
!__               else
!__                  do l=1,k
!__                     n=n+1
!__                  enddo
!__               endif
!__            enddo
!__         enddo
!__      enddo
!__      print*,'nb d''int',n
!__      ! Ijkl
!__      n=0
!__      do i=1,norb
!__         icl=iclasloc(i)
!__         do j=1,norb
!__            jcl=iclas(j)
!__            if(jcl>icl) cycle
!__            do k=1,norb
!__               kcl=iclas(k)
!__               if(kcl>icl) cycle
!__               do l=1,k
!__                  lcl=iclas(l)
!__                  if(lcl>icl) cycle
!__                  n=n+1
!__               enddo
!__            enddo
!__         enddo
!__         !print*,i,icl,n
!__      enddo
!__      print*,n,norb**4,norb**4/8
!__!     fin test


!
!     numero des orbitales symetriques dans la liste des classes
!
      i_loc=0
      allocate(nsym2loc(norb))
      allocate(nloc2sym(norb))
      do icl=1,ncl
         do n=1,nequis(icl)
            i_sym=iequis(icl,n)
            i_loc=i_loc+1
            nsym2loc(i_sym)=i_loc
            nloc2sym(i_loc)=i_sym
         enddo
      enddo
      if(nprint>2) then
         do k=1,norb
            print*,'nsym2loc,nloc2sym',k,nsym2loc(k),nloc2sym(k)
         enddo
      endif
!
!     initialisation des increments dans l'adressage
! 
      ! Ijkl incr1(I)
      allocate(incr1(0:norb))
      incr1=0
      i=0
      do icl=1,ncl
         do k=1,nequis(icl)
            i=i+1
            if(i==norb) exit
            j=iequiloc(icl,nequis(icl))
            if(yw)print*,j,icl,nequis(icl)
            call adrin1(i,j,j,j,incr1(i+1))
         enddo
         if(i<norb) incr1(i+1)=0
      enddo
      ! IJkl incr2(IJ)
      allocate(incr2(0:num1(norb+2)))
      incr2=0
      i=0
      do icl=1,ncl
         do ki=1,nequis(icl)
            i=i+1
            j=0
            do jcl=1,icl
               do kj=1,nequis(jcl)
                  j=j+1
                  if(j>i) exit
                  if(j==norb) exit
                  ij=num1(i+1)+j
                  k=iequiloc(icl,nequis(icl))
                  call adrin2(i,j,k,k,incr2(ij+1))
                  if(yw)print'(a,6i10)','incr2',i,j,k,incr2(ij+1)
               enddo
            enddo
         enddo
         !print*,'MAZincr2',i,j,ij
         if(i<norb) incr2(ij+1)=0
      enddo
      ! IJkl incr3k(Kl)
      allocate(incr3k(norb,norb))
      incr3k=0
      k=0
      kl=0
      do kcl=1,ncl
         do kk=1,nequis(kcl)
            k=k+1
            l=0
            do lcl=1,kcl
               do ll=1,nequis(lcl)
                  l=l+1
                  kl=kl+1
                  incr3k(k,l)=kl
                  if(yw)print*,'incr3k',k,l,incr3k(k,l)
               enddo
            enddo
         enddo
      enddo
      ! IJKl incr3(IJ)
      allocate(incr3(0:num1(norb+2)))
      incr3=0
      i=0
      do icl=1,ncl
         do ki=1,nequis(icl)
            i=i+1
            j=0
            do jcl=1,icl
               do kj=1,nequis(jcl)
                  j=j+1
                  if(j>i) exit
                  if(j==norb) exit
                  ij=num1(i+1)+j
                  l=iequiloc(icl,nequis(icl))
                  call adrin3(i,j,l,l,incr3(ij+1))
                  if(yw)print'(a,6i10)','incr3',i,j,k,incr3(ij+1)
               enddo
            enddo
         enddo
         if(yw)print*,'MAZincr3',i,j,ij
         if(i<norb) incr3(ij+1)=0
      enddo
      ! IJKL incr4(I)
      allocate(incr4(norb))
      incr4=0
      i=0
      n=0
      do icl=1,ncl
         n=num3(i+1)*3
         do ki=1,nequis(icl)
            i=i+1
            incr4(i)=n
         enddo
         if(yw)print*,'incr4,icl',incr4(i),icl,i,n,num3(i+1)
      enddo
      !verif
      if(.false.) then
      print*,'verif adrin1'
      n=0
      do i=1,norb
         if(rang(nloc2sym(i))==1) n=0
         icl=iclasloc(i)
         do jj=1,norb
            if(iclasloc(jj)>icl) exit
            j=jj
            do kk=1,norb
               if(iclasloc(kk)>icl) exit
               k=kk
               do ll=1,kk
                  l=ll
                  n=n+1
                  call adrin1(i,j,k,l,iadr)
                  if(yw)print*,'Adresse',i,j,k,l,iadr
                  if(iadr/=n) then     
                     print*,'stop',iadr,n,i,rang(i)
                     stop
                  endif
               enddo
            enddo
         enddo
      enddo
      if(yw)print*,'n1',n
      endif
      if(.false.) then
      print*,'verif adrin2'
      n=0
      do i=1,norb
         icl=iclasloc(i)
         if(rang(nloc2sym(i))==1) n=0
         do j=1,i
            !print*,'i,j,n',i,j,n
            do kk=1,norb
               if(iclasloc(kk)>icl) exit
               k=kk
               do ll=1,kk
                  l=ll
                  n=n+1
                  call adrin2(i,j,k,l,iadr)
                  if(yw)print*,'Adresse',i,j,k,l,iadr
                  if(iadr/=n) then     
                     print*,'stop',iadr,n,i,rang(i)
                     stop
                  endif
               enddo
            enddo
         enddo
      enddo
      if(yw)print*,'n2',n
      endif
      if(.false.) then
      print*,'verif adrin3'
      n=0
      do i=1,norb
         icl=iclasloc(i)
         if(rang(nloc2sym(i))==1) n=0
         do j=1,i
            if(yw)print*,'i,j,n',i,j,n
            do k=1,iequiloc(icl,nequis(icl))
               do ll=1,norb
                  if(iclasloc(ll)>iclasloc(k)) exit
                  l=ll
                  n=n+1
                  call adrin3(i,j,k,l,iadr)
                  if(yw)print*,'Adresse',i,j,k,l,iadr
                  if(iadr/=n) then     
                     print*,'stop3',iadr,n,i,rang(i)
                     stop
                  endif
               enddo
            enddo
         enddo
      enddo
      if(yw)print*,'n3',n
      endif
      ! IJKL
      if(.false.) then
      print*,'verif adrin4'
      n=0
      do i=1,norb
         if(rang(nloc2sym(i))==1) n=0
         do j=1,i-1
            do k=1,j-1
               do l=1,k-1
                  ii=i
                  jj=j
                  kk=k
                  ll=l
                  loci=(/ii,jj,kk,ll/)
                  call reori(loci,it,' ')
                  call iadri(loci,iadr,icas,i2,j2,it)
                  n=n+1
                  !if(yw)print'(a,10i7)','iadr4',ii,jj,kk,ll,iadr,n
                  if(iadr/=n) then     
                     print*,'stop4',iadr,n
                     stop
                  endif
                  loci=(/ii,jj,ll,kk/)
                  call reori(loci,it,' ')
                  call iadri(loci,iadr,icas,i2,j2,it)
                  n=n+1
                  !print'(a,10i7)','iadr4',ii,jj,ll,kk,iadr,n
                  if(iadr/=n) then     
                     print*,'stop4',iadr,n
                     stop
                  endif
                  loci=(/ii,kk,jj,ll/)
                  call reori(loci,it,' ')
                  call iadri(loci,iadr,icas,i2,j2,it)
                  n=n+1
                  !print'(a,10i7)','iadr4',ii,kk,jj,ll,iadr,n
                  if(iadr/=n) then     
                     print*,'stop4',iadr,n
                     stop
                  endif
               enddo
            enddo
         enddo
      enddo
      endif
      if(yw)print*,'n4',n
!
!     nombre max d'integrales Ijkl, IJkl, IJKl, IJKL
!
      madr1=0
      madr2=0
      madr3=0
      madr4=0
      iadr4=0
      do icl=1,ncl
         i=iequiloc(icl,nequis(icl))
         j=iequiloc(icl,nequis(icl))
         call adrin1(i,j,j,j,iadr1)
         call adrin2(i,i,j,j,iadr2)
         call adrin3(i,i,i,j,iadr3)
         if(i>=4)call iadri((/i,i-1,i-2,i-3/),iadr4,icas,i2,j2,2)
         !print*,icl,iadr1,iadr2,iadr3
!         print*,'Max Ijkl',icl,i,j,iadr1
!         print*,'Max IJkl',icl,i,j,iadr2
!         print*,'Max IJKl',icl,i,j,iadr3
         if(iadr1>madr1) then
            madr1=iadr1
            ladr1=icl
         endif
         if(iadr2>madr2) then
            madr2=iadr2
            ladr2=icl
         endif
         if(iadr3>madr3) then
            madr3=iadr3
            ladr3=icl
         endif
         if(iadr4>madr4) then
            madr4=iadr4
            ladr4=icl
         endif
      enddo
      print*,'taille des tableaux en memoire, classe correspondante'
      print*,'madr1',madr1,ladr1
      print*,'madr2',madr2,ladr2
      print*,'madr3',madr3,ladr3
      print*,'madr4',madr4,ladr4
      call flush(6)
      

!     repartition des integrales selon le plus grand indice
!     ecriture sur daf
!
      call repart_daf
      ycl=.false.
      print*,'fin de redistribution des integrales dans la DAF'
      if(itest(1)==1)call transforb
      return
      end subroutine
       subroutine reorcl(i,j,k,l)
      use module
      icl=iclas(i)
      jcl=iclas(j)
      kcl=iclas(k)
      lcl=iclas(l)
      if(icl<kcl) then
         call ech(i,k)
         call ech(icl,kcl)
      endif
      if(jcl<lcl) then
         call ech(j,l)
         call ech(jcl,lcl)
      endif
      if(icl<jcl) then
         call ech(i,j)
         call ech(k,l)
         call ech(icl,jcl)
         call ech(kcl,lcl)
      endif
      if(icl==jcl.and.kcl<lcl) then
         call ech(i,j)
         call ech(k,l)
      endif
      return
      end subroutine
       subroutine echa(i,j)
      real(8) i,j,k
      k=i
      i=j
      j=k
      return
      end subroutine
       subroutine ech(i,j)
      k=i
      i=j
      j=k
      return
      end subroutine



       subroutine repart_daf
      use module
      use modlirin
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      include '../../param/maxlong.prm'
      character(20) namel
      !dimension yyyy(1000000)
      ! yyyy=.false.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     repartition des integrales selon le plus grand indice
!     ecriture sur DAF
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
      yw=.false.
      yw1=.false.
      if(maxlong_modif<0) maxlong_modif=maxlong
      write(namel,'(i13)') maxlong_modif
      namel=adjustl(namel)
      call titre('Longueur max des fichiers (en kb) '
     *//trim(namel)//'#',50)
      call cpu_time(t0)
      allocate (ijkl_cl(3,1024,norb))
      allocate (a_cl(1024,norb))
!
!     Ouverture d'une file a acces direct pour les int 
      inquire(iolength=long) a_cl(:,i),ijkl_cl(:,:,i)
      open(21,form='unformatted',access='direct',recl=long,
     *status='unknown',file='DAFIJKL')
!      call filesplit('OPEN',21,43009,ichange,idum)
!      print*,'ouverture DAFIJKL'
      call filesplit('OPEN',21,maxlong_modif*1000,ichange,idum)
      !print*,'ouverture DAFIJKL'
!
!     Rel d'equivalence : avoir meme plus grand indice
!
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! nombre d'integrales dans une classe (nint_par_classe)
      ! nombre d'enregistrements dans une classe
      allocate(nint_par_classe(norb))
      nint_par_classe=0
      allocate(nrec_dela_classe(norb))
      nrec_dela_classe=0
!
      !initialisation lecture et mises a zero
      call liri00
      irec=0
      jrec=0
      iirec=0
      nintl=0
      nbenr_numrec=0
      open(23,form='unformatted',status='unknown',file='NUMREC')
      do
         ! on lit l'int ijkl
         call lirin(i_s,j_s,k_s,l_s,a)
         if(yw)print'(a,4i4)','repart lue',i_s,j_s,k_s,l_s
         ! on renumerote les indices juste apres la lecture,
         ! pour que la classe 1 ait les orb 1,2,3... etc...
         if(k_s.eq.0) exit
         i=nsym2loc(i_s)
         j=nsym2loc(j_s)
         k=nsym2loc(k_s)
         l=nsym2loc(l_s)
         if(yw)print'(a,4i4,f12.8)','repart i,j,k,l',i,j,k,l,a
         nintl=nintl+1
         call reor_ind_int(i,j,k,l)
         ! apres reor_ind_int, l'int est de la classe i
         if(yw)print'(a,4i4)','repart i,j,k,l apres reor',i,j,k,l
         nint_par_classe(i)=nint_par_classe(i)+1
         ! on remplit le buffer a_cl et ijkl_cl
         a_cl(nint_par_classe(i),i)=a
         ijkl_cl(:,nint_par_classe(i),i)=(/j,k,l/)
         !print'(a,10i5)','ijkl_cl',i,j,k,l,nint_par_classe(i)
         if(yw)print'(a,4i4,f12.8)','repart ecrit',nloc2sym((/j,k,l/))
         !ecriture si le buffer est plein
         if(nint_par_classe(i)==1024) then
            nint_par_classe(i)=0
            ! jrec concerne numrec, classe de l'enregistrement
            ! jrec est remis a zero chaque 1024 enregistrements
            ! irec s'incremente de 1 a chaque enregistrement
            ! il est remis a zero si jamais on change de fichier
            ! (si fichier trop grand)
            ! iirec s'incremente de 1 a chaque enregistrement
            ! et n'est jamais remis a zero
            irec=irec+1
            jrec=jrec+1
            iirec=iirec+1
            call filesplit('WRITE',21,2*3*1024+8*1024,ichange,irec)
            if(ichange==1) irec=1
            if(yw)print*,'ECRITURE IREC',irec
            write(21,rec=irec) a_cl(:,i),ijkl_cl(:,:,i)
            !do kkk=1,10
            !print*,'moddi ecriture irec=',irec,' indices',i,ijkl_cl(:,kkk,i)
            !enddo
            ! on note la classe de l'enregistrement fait
            numrec(jrec)=i
            if(jrec==1024) then
               jrec=0
               write(23) numrec
               nbenr_numrec=nbenr_numrec+1
            endif
            nrec_dela_classe(i)=nrec_dela_classe(i)+1
         endif
      enddo
      if(yw1) then
         print*,'fin 1er remplissage'
         print*,'nintl=',nintl
         do k=1,norb
            print*,'nint_par_classe',nint_par_classe(k)
         enddo
      endif
      !
      ! fin des ecritures
      !
      do i=1,norb
         irec=irec+1
         jrec=jrec+1
         iirec=iirec+1
         numrec(jrec)=i
         call filesplit('WRITE',21,2*3*1024+8*1024,ichange,irec)
         if(ichange==1) irec=1
         write(21,rec=irec) a_cl(:,i),ijkl_cl(:,:,i)
!          do kkk=1,10
!        print*,'moddi ecriture irec=',irec,' indices',i,ijkl_cl(:,kkk,i)
!        enddo
         nrec_dela_classe(i)=nrec_dela_classe(i)+1
         if(jrec==1024) then
            jrec=0
            write(23) numrec
            nbenr_numrec=nbenr_numrec+1
         endif
      enddo
      if(yw1) then
         print*,'nrec_dela_classe',nrec_dela_classe
      endif
      write(23) numrec
      nbenr_numrec=nbenr_numrec+1
      if(yw1) print*,'nbenr_numrec',nbenr_numrec
      if(yw1) print*,'iirec,irec',iirec,irec
!
!     On decode numrec pour remplir le tableau:
!     numrec_dela_classe
!
      allocate(numrec_dela_classe(iirec))
      allocate(ifin_dela_classe(0:norb))
      rewind 23
      ifin_dela_classe=0
      !ifin_dela_classe(0)=-nrec_dela_classe(1)
      do i=1,norb
         if(yw)print*,'nrec_dela_classe',i,nrec_dela_classe(i)
      enddo
      do i=2,norb
         ifin_dela_classe(i)=ifin_dela_classe(i-1)+nrec_dela_classe(i-1)
      enddo
      if(yw)print*,'ifin_dela_classe'
      if(yw)print'(10i8)',ifin_dela_classe(1:norb)
      do i=1,norb
         if(yw1)print'(a,10i7)',
     *   'classe,long,long,ifin_dela_classe,nint_der_enr',
     *   i,nrec_dela_classe(i),
     *   ifin_dela_classe(i)-ifin_dela_classe(i-1),
     *   ifin_dela_classe(i),
     *   nint_par_classe(i)
      enddo
      if(yw)print*,'irec',irec
      if(yw)print*,'nbenr_numrec',nbenr_numrec
      lrec=0
!      do krec=1,nbenr_numrec
!         read(23) numrec
!         kfin=1024
!         if(krec==nbenr_numrec) kfin=jrec
!         do k=1,kfin
!            lrec=lrec+1
!            print'(a,10i7)','NUMREC',krec,numrec(k),lrec,kfin
!         enddo
!      enddo
!      rewind 23
      nn=0
      do krec=1,nbenr_numrec
         read(23) numrec
         kfin=1024
         if(krec==nbenr_numrec) kfin=jrec
!        on a l'info sur kfin enregistrements
         do k=1,kfin
!           i est la classe de l'enr k
            nn=nn+1
            i=numrec(k)
            yyw=i==13.or.i==norb
            yyw=.false.
            ifin_dela_classe(i)=ifin_dela_classe(i)+1
            if(yyw)print*,'krec,kfin,jrec,k',krec,kfin,jrec,k
            if(yyw)print*,'i,ifin_dela_classe(i)',i,ifin_dela_classe(i)
            if(ifin_dela_classe(i)>iirec) print*,'depassement',i,iirec
            numrec_dela_classe(ifin_dela_classe(i))=nn
            !if(yyyy(nn)) then
            !   print*,'yyyy true',nn
            !endif
            !yyyy(nn)=.true.
         enddo
      enddo
      if(yw1) then
         do i=1,norb
            print*,'ifin_dela_classe',i,ifin_dela_classe(i)
         enddo
         do i=1,norb
            print*,'orbitale',i,'  nb d''enr',nrec_dela_classe(i),
     *      ifin_dela_classe(i)-ifin_dela_classe(i-1)
            print'(10i8)',numrec_dela_classe(ifin_dela_classe(i-1)+1:
     *      ifin_dela_classe(i))
         enddo
      endif
      !do k=1,iirec
      !   if(.not.yyyy(k)) print*,'yyyy false',k
      !enddo
      !do k=iirec+1,100000
      !   if(yyyy(k)) print*,'yyyy trop grand',k
      !enddo
      close(23,status='delete')
      call cpu_time(t1)
      print'(a,f12.2)','fin remplissage DAF    cpu',t1-t0
      print*,'nombre d''nregistrements su la DAF',iirec
      taille=(1.d0*iirec)*1024*14
      print'(a,f10.6)',' taille en Gb',taille/1000000000
      call flush(6)
      return
      end subroutine
       subroutine reor_ind_int(i,j,k,l)
      if(i<j) call ech(i,j)
      if(k<l) call ech(k,l)
      if(i<k) then
         call ech(i,k)
         call ech(j,l)
      else if(i==k) then
         if(j<l) call ech(j,l)
      endif
      return
      end subroutine

          
       subroutine adrin1(i,j,k,l,iadr)
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! adresse de l'integrale Ijkl
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      icl=iclasloc(i)
!      jj=nsym2loc(j)
!      kk=nsym2loc(k)
!      ll=nsym2loc(l)
      jj=j
      kk=k
      ll=l

      iadrj=j
      iadrkl=num1(kk+1)+ll
      nkl=num1(iequiloc(icl,nequis(icl))+2)
      iadr=incr1(i)+(jj-1)*nkl+iadrkl
!      print'(a,11i5,i8,i6)','adrin1',i,j,k,l,jj,kk,ll,iadrkl,nkl,
!     *iclas(k),incr1(i),iadr,(jj-1)*nkl+iadrkl
      
      return
      end subroutine
       subroutine adrin2(i,j,k,l,iadr)
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! adresse de l'integrale IJkl
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      ij=num1(i+1)+j
      iadrkl=num1(k+1)+l
      iadr=incr2(ij)+iadrkl
!      print'(a,8i7,i15)','adrin2',i,j,k,l,iadrij,iadrkl,
!     *incr2(ij),iadr
      
      return
      end subroutine
       subroutine adrin3(i,j,k,l,iadr)
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! adresse de l'integrale IJKl
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      lcl=iclasloc(l)
      kcl=iclasloc(k)
      ij=num1(i+1)+j
      iadr=incr3(ij)+incr3k(k,l)
!      print'(a,6i7,i15)','adrin3',i,j,k,l,incr3k(k,l),
!     *incr3(ij),iadr
      return
      end subroutine
      end module
