      subroutine regensym(i,j,k,l,loci,nintsy,nintsy2,a1,aa2)
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension loci(4,8),loci3(4)
      dimension a(3),a1(3),aa2(3,8)
      yw=.false.
      yw1=.false.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! generation des integrales equivalentes
! en entree : i,j,k,l,a1   (integrale)
! en sortie : nintsy=nb d'int equivalentes
!             loci,aa2= integrales equivalentes
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
      loci(1,1)=i
      loci(2,1)=j
      loci(3,1)=k
      loci(4,1)=l
      if(intsy/='SYM') then
         nintsy=1
         nintsy2=1
         return
      endif
      nintsy=1
      nintsy2=1
      a=a1
      if(yw)print'(a,4i4,3f20.15)','regensym loci',loci(:,1),a1
      aa2(:,1)=a
      call roer(4,loci(:,1),aa2(:,1))
      if(yw)print'(a,4i4,3f20.15)','loci(1)',loci(:,1),a
      do i=2,nsym
         a=a1
         isgn=1
         do k=1,4
            loci3(k)=image(loci(k,1),i)
!            if(image(loci(k,1),i)==loci(k,1))
!     *      isgn=isgn*images(loci(k,1),i)
            isgn=isgn*images(loci(k,1),i)
         enddo
         call roer(4,loci3,a)
         do j=1,i-1
            if(all(loci3==loci(:,j))) goto 1
         enddo
         nintsy=nintsy+1
         loci(:,nintsy)=loci3
         aa2(:,nintsy)=a*isgn
         !print*,'garde',aa2(:,nintsy)
 1       continue
      enddo
      if(is0/=0) then
         aa2(:,1)=aa2(:,1)*nintsy
         nintsy2=nintsy
         nintsy=1
      endif
      if(yw) then
         do i=2,nintsy
            a=aa2(:,i)
            print'(a,i1,a,4i4,3f20.15)','loci(',i,')',loci(:,i),a
         enddo
      endif
      return
      end
       subroutine regensym3(i,j,k,loci,nintsy,a1,aa2)
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension loci(3,8),loci3(3)
      dimension loci4(4),loci4r(4),loci4r1(4)
      dimension a(2),a1(2),aa2(2,8),abid(4)
      yw=.false.
      yw1=.false.
      !
      ! generation des integrales equivalentes
      !
      nintsy=1
      loci(1,1)=i
      loci(2,1)=j
      loci(3,1)=k
      if(intsy/='SYM') return
      ! on reecrit l'integrale en 4 indices
      loci4=(/loci(:,1),loci(1,1)/)
      if(yw)print*,'loci',loci(:,1)
      if(yw)print*,'loci4',loci4
      call roer(4,loci4,abid)
      a=a1
      if(yw)print'(a,4i4,2f20.15)','regensym3 int entree',loci4,a1
      aa2(:,1)=a
      do i=2,nsym
         if(yw)print*,'////sym///////',i
         a=a1
         isgn=1
         do k=1,4
            loci4r(k)=image(loci4(k),i)
            !if(loci4(k)==loci4r(k)) isgn=isgn*images(loci4(k),i)
            isgn=isgn*images(loci4(k),i)
         enddo
         if(yw)print*,'isgn',isgn,images(loci4(1:4),i) 
         if(yw)print'(a,4i4,2f20.15)','regensym3 int transf',loci4r,a1
         call roer(4,loci4r,abid)
         do j=1,i-1
            loci4r1=image(loci4(:),j)
            call roer(4,loci4r1,abid)
            if(yw)print'(a,2i4)','sym',i,j
            if(yw)print'(a,4i4)','loci4r1',loci4r1
            if(yw)print'(a,5i4)','image',image(loci4(:),j),j
            if(yw)print*,all(loci4r==loci4r1)
            if(all(loci4r==loci4r1)) goto 1
         enddo
         if(yw)print*,'regensym3 int gardee'
         nintsy=nintsy+1
         if(yw)print'(a,4i4,2f20.15,i4)',
     *   'regensym3 loci4r,nintsy',loci4r,a1,nintsy
         ! on revient a 3 indices
         do k=1,3
            if(loci4r(k)==loci4r(k+1)) then
               loci(1,nintsy)=loci4r(k)
               ll=1
               do l=1,k-1
                  ll=ll+1
                  loci(ll,nintsy)=loci4r(l)
               enddo
               do l=k+2,4
                  ll=ll+1
                  loci(ll,nintsy)=loci4r(l)
               enddo
               exit
            endif
         enddo
         if(yw)print'(a,3i4,2f20.15)','regensym3 loci',loci(:,nintsy),a1
         aa2(:,nintsy)=a*isgn
         !print*,'garde',aa2(:,nintsy)
 1       continue
      enddo
      if(yw) then
         do i=2,nintsy
            print'(a,i1,a,3i4,2f20.15)','loci(',i,')',loci(:,i),aa2(:,i)
         enddo
      endif
      return
      end
       subroutine regensym2(aaa,ysgn)
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension aaa(norb,norb)
      logical ysgn
      yw=.false.
      !print*,'entree regensym2'
      if(intsy/='SYM') return
      do i=1,norb
! i est le plus grand indice. Est-il principal ?
         if(i/=maxval(image(i,:))) cycle
! i est principal. la valeur de aaa(i,?) est donc juste. On la transfere
! sur les autres aaa(image(i,is),j)
         do j=1,i
            do is=2,nsym
               ii=max(image(i,is),image(j,is))
               if(ii==0) exit
! ii est le plus grand indice. Est-il principal ?
               if(ii==maxval(image(ii,:))) cycle
               jj=min(image(i,is),image(j,is))
               if(jj==0) exit
               if(i==ii.and.j==jj) cycle
               if(ysgn) then
                  if(i==j) cycle
                  isgn=images(i,is)*images(j,is)
                  if(yw)print'(2i3,a,4i3,2f10.6,2i3)',i,j,
     *            '  transferes en',ii,jj,isgn,is,aaa(i,j),aaa(j,i)
     *            ,images(i,is),images(j,is)
                  aaa(ii,jj)=aaa(i,j)*isgn
                  aaa(jj,ii)=aaa(j,i)*isgn
               else
                  aaa(ii,jj)=aaa(i,j)
                  aaa(jj,ii)=aaa(j,i)
               endif
            enddo
         enddo
      enddo
      return
      end
       subroutine roer(n,it,a)
      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
      
      
