      subroutine locsymint(loci,ibon)
      !
      ! Symetrie/priorite d'une integrale
      !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Si on prend en commpte la symetrie des int :
! En entree : loci=indice de l'int
! En sortie : ibon=0 : l'int est principale
!             ibon=-2 : l'int est secondaire
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
      use module
      use moddi
      use mod_disin
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer,dimension(4) :: loci,cl,loci3
      dimension jtsyml(3),ktsyml(4,3)
      yw=.false.
      yw1=.false.
      if(yw) print*,'entree locsymint',loci
      !
      ! on ne s'occupe que des integrales i>j>k>l
      !
      if(loci(1)==loci(2).or.loci(2)==loci(3).or.loci(3)==loci(4)) then
         ibon=0
         return
      endif
      !
      ! on stocke les sym des indices de l'int dans ktsyml
      do k=1,4
         ktsyml(k,1:nop)=princl(loci(k),:)
      enddo
      cl=iclasloc(loci)
      !write(91,'(4i4,3F12.8)') loci,a
      if(any(ktsyml(1,:)==-2)) then
         if(yw) print*,'refuse 1 -2'
         ibon=-2
!        l'integrale est refusee car son 1er indice est secondaire
!        par rapport a au moins une transformation
         return
      endif
!     Si on arrive ici,
!     le 1er indice de l'integrale est, par rapport a chaque operation
!     soit principal (=2) soit invariant (=1)
      do i=2,nsym
         do k=1,4
            loci3(k)=image(loci(k),i)
         enddo
         call roer0(4,loci3)
         if(yw)print'(a,4i4)','loci3',loci3
!        la boucle suivante, de 1 a 4, se poursuit seulement
!        si l'indice est 1
!        Le 1er indice non invariant (/=1) doit etre egal a 2
!        s'il vaut -2, il sera superieur dans loci3 par rapport a loci
!        l'int sera alors refusee
!!!!!!!!!rem ???? ce test est sans doute suffisant. Il n'est pas besoin
!        du test sur le 1ere indice
         do k=1,4
            if(loci3(k)>loci(k)) then
               if(yw) print*,'refuse 2 -2',jtsyml
               ibon=-2
               return
            else if(loci3(k)<loci(k)) then
               goto 1
            endif
         enddo
 1       continue
      enddo
      if(yw) print*,'accepte'
      ibon=0
      return
      end
      subroutine locsymint3(loci,ibon)
      !
      ! Symetrie/priorite d'une integrale
      !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Si on prend en commpte la symetrie des int :
! En entree : loci=indice de l'int
! En sortie : ibon=0 : l'int est principale
!             ibon=-2 : l'int est secondaire
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      use module
      use moddi
      use mod_disin
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer,dimension(3) :: loci,cl,loci3
      integer,dimension(4) :: loci4,loci4r
      dimension jtsyml(3),ktsyml(3)
      yw=.false.
      yw1=.false.
      if(yw) print*,'entree locsymint3',loci
      !
      ! on met les 3 indices dans une integrale a 4 indices
      loci4=(/loci,loci(1)/)
      call roer0(4,loci4)
      if(yw)print'(a,4i4)','loci4',loci4
      ! on stocke les sym du 1er indice de l'int dans ktsyml
      ktsyml(1:nop)=princl(loci4(1),:)
      cl=iclasloc(loci)
      !write(91,'(4i4,3F12.8)') loci,a
      if(any(ktsyml==-2)) then
         if(yw) print*,'refuse 1 -2'
         ibon=-2
         return
      endif
      do i=2,nsym
         do k=1,4
            loci4r(k)=image(loci4(k),i)
         enddo
         call roer0(4,loci4r)
         if(yw)print'(a,4i4)','loci4r',loci4r
         do k=1,4
            if(loci4r(k)>loci4(k)) then
               if(yw) print*,'refuse 2 -2',jtsyml
               ibon=-2
               return
            else if(loci4r(k)<loci4(k)) then
               goto 1
            endif
         enddo
 1       continue
      enddo
      if(yw) print*,'accepte'
      ibon=0
      return
      end
       subroutine testsymint
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! subroutine de test   non utilisee en temps normal
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      use module
      use moddi
      use mod_disin
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer,dimension(4) :: loci,cl
      integer(2),dimension(4096) :: iint,jnt,knt,lnt
      dimension a(3)
      yw=.false.
      yw1=.false.
      allocate(aaloc(3,4096))
      !
      ! transformation des orbitales par chaque symetrie
      !
      call transforb
      rewind 31
      n=0
      iacc=0
      iref2=0
      iregen=0
      do 
         read(31) iint,jnt,knt,lnt,aaloc
         do k=1,4096
            if(knt(k)==0) goto 1
            loci=(/iint(k),jnt(k),knt(k),lnt(k)/)
            if(yw)print'(a,4i4,i8)','testsymint',loci,k
            a=aaloc(:,k)
            call locsymint(loci,ibon)
            if(ibon==-2) then
               iref2=iref2+1
            else
               iacc=iacc+1
            endif
            if(ibon/=0) cycle
            n=n+1
            call regensym(loci,a,iregen)
         enddo
      enddo
 1    continue
      if(yw1)print*,'nombre d''integrales acceptees sur 31',n
      if(yw1)print*,'acceptees    iacc',iacc
      if(yw1)print*,'refusees    iref2',iref2
      if(yw1)print*,'regenerees iregen',iregen
      return
      end
       subroutine regensym(loci,a1,iregen)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! subroutine de test (avec testsymint)   non utilisee en temps normal
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      use module
      use moddi
      use mod_disin
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer,dimension(4) :: loci,cl,nu
      dimension loci2(4,8),loci3(4)
      dimension jtsyml(3),ktsyml(4,3),a(3),a1(3),aa2(3,8)
      integer,save :: jac=0,jref2=0,kref2=0
      yw=.false.
      yw1=.false.
      cl=iclasloc(loci)
      nu=rang(loci)
      if(yw)print'(a,4i4)','cl',cl
      if(yw)print'(a,4i4)','nu',nu
      if(yw)print'(a,4i4,3f12.8)','loci',loci,a1
      ifac=1
      jtsyml=1
      jac=jac+1
      do k=1,4
         ktsyml(k,:)=princl(loci(k),:)
      enddo
      do k=1,4
         do l=1,3
            if(abs(ktsyml(k,l))==2) jtsyml(l)=2
         enddo
         if(yw) print'(2a,i4,4x,3i4,4x,2i8)',
     *   'regensym ktsyml  ',tipotmp(k+ngel),
     *    loci(k),ktsyml(k,:),cl(k),nequis(cl(k))
      enddo
      ifac=jtsyml(1)*jtsyml(2)*jtsyml(3)
      jref2=jref2+ifac-1
      !
      ! generation des integrales equivalentes
      !
      n=1
      a=a1
      do i=1,4
         loci2(i,1)=loci(i)
      enddo
      aa2(:,1)=a
      if(yw)print*,'A',a
      call roer(4,loci2(:,1),aa2(:,1))
      if(yw)print*,'A',a
      if(yw)print'(a,4i4)','loci2(1)',loci2(:,1)
            write(92,'(4i4,3f12.8)') loci2(:,1),aa2(:,1)
      do i=2,nsym
         a=a1
         isgn=1
         do k=1,4
            loci3(k)=image(loci(k),i)
            if(image(loci(k),i)==loci(k)) isgn=isgn*images(loci(k),i)
         enddo
         call roer(4,loci3,a)
         if(yw)print'(a,4i4,3f12.8)','loci3',loci3,a
         do j=1,i-1
            if(all(loci3==loci2(:,j))) goto 1
         enddo
         n=n+1
         loci2(:,n)=loci3
         aa2(:,n)=a*isgn
         iregen=iregen+1
 1       continue
      enddo
      do i=2,n
      if(yw)print'(a,4i4)','loci2(n)',loci2(:,i)
            write(92,'(4i4,3f12.8)') loci2(:,i),aa2(:,i)
      enddo
      kref2=kref2+n-1
      if(yw)print'(a,3i3,10x,4i6)','jtsyml',jtsyml,ifac,jac,jref2,kref2

      
      return
      end

      

       subroutine transforb
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Calcul de image et images
! image(i,is)=j :
! l'orb i se transforme en orb j sous l'operation is
! images(i,is)=isgn : 
! l'orb i se transforme sous l'operation is avec le signe isgn (+/-1)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!
!========================================================================
! Methode :
! 1. boucle sur les classes d'orb icl. io1 est la 1ere orb de la classe
! (io1=iequiloc(icl,1))
! 2. si io1 se transforme en 8 orb differentes : 
!    image(io1  ,:)=(/0,1,2,3,4,5,6,7/)+io1
!    de meme : image(io1+1,:)=(/1,0,3,2,5,4,7,6/)+io1
!    etc...

      use module
      use moddi
      use mod_disin
      use mod_script
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension isym1(8)
      isym1=(/1,2,2,2,3,3,3,3/)
      allocate(image(norb,nsym))
      allocate(images(norb,nsym))
      image=0
      images=0
      !ii=image(norb+1,1)
      !stop'Transforb'
      !print*,'entree transforb',nsym
      !call mscript(iequiloc)
      !stop
      io=0
      if(nsym==8) then
         do icl=1,ncl
            io1=iequiloc(icl,1)
            images(io1:io1+nequis(icl)-1,1)=1
            do k=io1,io1+nequis(icl)-1
               images(k,2:8)=itsyml(k,:)
            enddo
            if(abs(princl(io1,1))==2) then
               ! alors io1 est variable / 1ere operation
               if(abs(princl(io1,2))==2) then
                  ! alors io1 est variable / 2eme operation
                  if(abs(princl(io1,3))==2) then
                     ! alors io1 est variable / 3eme operation
                     image(io1  ,:)=(/0,1,2,3,4,5,6,7/)+io1
                     image(io1+1,:)=(/1,0,3,2,5,4,7,6/)+io1
                     image(io1+2,:)=(/2,3,0,1,6,7,4,5/)+io1
                     image(io1+3,:)=(/3,2,1,0,7,6,5,4/)+io1
                     image(io1+4,:)=(/4,5,6,7,0,1,2,3/)+io1
                     image(io1+5,:)=(/5,4,7,6,1,0,3,2/)+io1
                     image(io1+6,:)=(/6,7,4,5,2,3,0,1/)+io1
                     image(io1+7,:)=(/7,6,5,4,3,2,1,0/)+io1
                  else
                     ! alors io1 est invariante / 3eme operation (z)
                          ! z
                     image(io1  ,:)=(/0,1,2,3,0,1,2,3/)+io1
                     image(io1+1,:)=(/1,0,3,2,1,0,3,2/)+io1
                     image(io1+2,:)=(/2,3,0,1,2,3,0,1/)+io1
                     image(io1+3,:)=(/3,2,1,0,3,2,1,0/)+io1
                  endif
               else
                  ! alors io1 est invariante / 2eme operation (y)
                  if(abs(princl(io1,3))==2) then
                          ! y
                     image(io1  ,:)=io1+(/0,1,0,1,2,3,2,3/)
                     image(io1+1,:)=io1+(/1,0,1,0,3,2,3,2/)
                     image(io1+2,:)=io1+(/2,3,2,3,0,1,0,1/)
                     image(io1+3,:)=io1+(/3,2,3,2,1,0,1,0/)
                  else
                          ! yz
                     image(io1  ,:)=io1+(/0,1,0,1,0,1,0,1/)
                     image(io1+1,:)=io1+(/1,0,1,0,1,0,1,0/)
                  endif
               endif
            else
               ! alors io1 est invariante / 1ere operation (x)
               if(abs(princl(io1,2))==2) then
                  if(abs(princl(io1,3))==2) then
                          ! x
                     image(io1  ,:)=io1+(/0,0,1,1,2,2,3,3/)
                     image(io1+1,:)=io1+(/1,1,0,0,3,3,2,2/)
                     image(io1+2,:)=io1+(/2,2,3,3,0,0,1,1/)
                     image(io1+3,:)=io1+(/3,3,2,2,1,1,0,0/)
                  else
                          ! xz
                     image(io1  ,:)=io1+(/0,0,1,1,0,0,1,1/)
                     image(io1+1,:)=io1+(/1,1,0,0,1,1,0,0/)
                  endif
               else
                  if(abs(princl(io1,3))==2) then
                          ! yz
                     image(io1  ,:)=io1+(/0,0,0,0,1,1,1,1/)
                     image(io1+1,:)=io1+(/1,1,1,1,0,0,0,0/)
                  else
                          ! xyz
                     image(io1,:)=io1+(/0,0,0,0,0,0,0,0/)
                  endif
               endif
            endif
            if(mprint(1)>0) then
               do io=io1,io1+nequis(icl)-1
                  print'( a,i4,2x,8i4)','image',io,
     *            image(io,:)*images(io,:)
               enddo
            endif
         enddo
      else if(nsym==4) then
         do icl=1,ncl
            io1=iequiloc(icl,1)
            images(io1:io1+nequis(icl)-1,1)=1
            do k=io1,io1+nequis(icl)-1
               images(k,2:4)=itsyml(k,:)
            enddo
            if(abs(princl(io1,1))==2) then
               ! alors io1 est princ / 1ere operation
               if(abs(princl(io1,2))==2) then
                  ! alors io1 est princ / 2eme operation
                  image(io1  ,:)=(/0,1,2,3/)+io1
                  image(io1+1,:)=(/1,0,3,2/)+io1
                  image(io1+2,:)=(/2,3,0,1/)+io1
                  image(io1+3,:)=(/3,2,1,0/)+io1
               else
                  ! alors io1 se transforme en elle-meme / 2eme operation
                       ! y
                  image(io1  ,:)=io1+(/0,1,0,1/)
                  image(io1+1,:)=io1+(/1,0,1,0/)
               endif
            else
               ! alors io1 se transforme en elle-meme / 1ere operation
               ! io1 est princ / 2eme operation
               if(abs(princl(io1,2))==2) then
                       ! x
                  image(io1  ,:)=io1+(/0,0,1,1/)
                  image(io1+1,:)=io1+(/1,1,0,0/)
               else
                       ! xy
                  image(io1,:)=io1+(/0,0,0,0/)
                  images(io1,2)=itsyml(io1,1)
               endif
            endif
            if(mprint(1)>0) then
               do io=io1,io1+nequis(icl)-1
                  print'( a,i4,2x,8i4)','image',io,
     *            image(io,:)*images(io,:)
               enddo
            endif
!            do io=io1,io1+nequis(icl)-1
!               print'( a,i4,2x,8i4)','image',io,image(io,:)*
!     *         images(io,:)
!            enddo
         enddo
      else if(nsym==2) then
         do icl=1,ncl
            io1=iequiloc(icl,1)
            images(io1:io1+nequis(icl)-1,1)=1
            do k=io1,io1+nequis(icl)-1
               images(k,2)=itsyml(k,1)
            enddo
            if(abs(princl(io1,1))==2) then
               image(io1  ,:)=(/0,1/)+io1
               image(io1+1,:)=(/1,0/)+io1
            else
               image(io1,:)=io1+(/0,0/)
            endif
            if(mprint(1)>0) then
               do io=io1,io1+nequis(icl)-1
                  print'( a,i4,2x,8i4)','image',io,
     *            image(io,:)*images(io,:)
               enddo
            endif
!            do io=io1,io1+nequis(icl)-1
!               print'( a,i4,2x,8i4)','image',io,image(io,:)*
!     *         images(io,:)
!            enddo
         enddo
      endif
      return
      end
       subroutine roer(n,it,a)
      use moddi
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      dimension it(n),a(3),ii(1)
      yw=.false.
      yw1=.false.
      i=it(1)
      j=it(2)
      k=it(3)
      l=it(4)
      if(yw)print'(a,4i4,3f12.8)','it',it,a
      ii=maxloc(it)
      if(ii(1)==2) then
         call ech(i,j)
         call echa(a(1),a(2))
      else if(ii(1)==3) then
         call ech(i,k)
         call echa(a(3),a(2))
      else if(ii(1)==4) then
         call ech(i,l)
         call echa(a(3),a(1))
      endif
      if(yw)print'(a,4i4,3f12.8)','it2',i,j,k,l,a
      it=(/i,j,k,l/)
      ii=maxloc(it(2:4))+1
      if(yw)print*,'ii',ii
      if(ii(1)==3) then
         call ech(j,k)
         call echa(a(1),a(3))
      else if(ii(1)==4) then
         call ech(j,l)
         call echa(a(3),a(2))
      endif
      if(yw)print'(a,4i4,3f12.8)','it3',i,j,k,l,a
      if(k<l) then
         call ech(k,l)
         if(yw)print*,'a',a
         call echa(a(1),a(2))
         if(yw)print*,'a',a
      endif
      it=(/i,j,k,l/)
      if(yw)print*,'itf',it
      return
      end
       subroutine roer0(n,it)
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      dimension it(n),a(3)
      do 1 i=1,n-1
      do 2 j=i+1,n
      if(it(j).le.it(i)) goto 2
      ii=it(i)
      it(i)=it(j)
      it(j)=ii
 2    continue
 1    continue
      return
      end
