      subroutine symetrie
      use bas
      use mod_sym
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter (maxsym=8)
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      common/pr/nprint
      character*10000 namel
      character(40) sym
      ! si on a deja appele la subroutine, on ne recommence pas
      if(ysym) return
      yw=.false.
      allocate(mult1(natom*nsym))
! Operations de symetrie
      sym=' '
      call LECNAM('&ORB ',namel,93,ierr,0)
      call namela(namel,SYM,'SYMM')
      call fnormaligo(sym,l)
      msym=1
      do k=1,l
         if(sym(k:k)==' ') msym=msym+1
      enddo
      if(yw)print*,'l',l
      if(yw)print*,'sym ',sym
      if(yw)print*,'msym',msym
      if(msym>=1)print'(a30,a)',  'Symetries donnees dans &orb   ',sym
      call msgener(sym,sym1,msym)
      if(msym>=1)
     *print'(a30,7a4)','...+ generation des autres    ',sym1(1:msym)
! Generation des atomes en symetrie
      natom1=natom
      do k=1,natom
         call gsatom(natom1,k,sym1,msym,mult1)
      enddo
      if(yw.or.nprint>0) then
         do k=1,natom1
            print'(a,i6,2a,3f12.8,i5)','atom'
     *   ,k,'  ',atom(k),coor(:,k),mult1(k)
         enddo
      endif
      print'(a,i5,a,i5,a)','Generation des atomes en symetrie',natom,
     *' --> ',natom1,' (total)'
      print*,' '
      return
      end
       subroutine gsatom(natom1,k,sym1,msym,mult1)
      use bas
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      parameter(maxsym=8)
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      logical y,yw
      character(3) sym1(7)
      dimension coor1(3),coor2(3)
      dimension mult1(natom*nsym)
      yw=.false.
      matom1=natom1
      coor2=coor(:,k)
      if(yw)print*,'natom1,k,msym',natom1,k,msym
      do is=1,msym
         coor1=coor2
         if(index(sym1(is),'X')>0) coor1(1)=-coor2(1)
         if(index(sym1(is),'Y')>0) coor1(2)=-coor2(2)
         if(index(sym1(is),'Z')>0) coor1(3)=-coor2(3)
         anorm2=(coor1(1)-coor(1,k))*(coor1(1)-coor(1,k))+
     *   (coor1(2)-coor(2,k))*(coor1(2)-coor(2,k))+
     *   (coor1(3)-coor(3,k))*(coor1(3)-coor(3,k))
         if(yw)print*,'ANORM2',anorm2,'   sym1(is)',sym1(is)
         if(yw)print*,'coor1',coor1
         if(yw)print*,'coor2',coor2
         if(anorm2<1.d-6) cycle
         y=.false.
         if(yw)print*,'matom1+1,natom1',matom1+1,natom1
         do i=matom1+1,natom1
            anorm2=(coor1(1)-coor(1,i))*(coor1(1)-coor(1,i))+
     *      (coor1(2)-coor(2,i))*(coor1(2)-coor(2,i))+
     *      (coor1(3)-coor(3,i))*(coor1(3)-coor(3,i))
            if(anorm2<1.d-6) y=.true.
         enddo
         if(y) cycle
         natom1=natom1+1
         coor(:,natom1)=coor1
         atom(natom1)=atom(k)
      enddo
      if(yw)print*,'sortie gsatom'
      if(yw)print*,'natom1',natom1
      if(yw)print'(a,i7,3f10.6)','COOR',k,coor(:,k)
      do kk=matom1+1,natom1
         if(yw)print'(a,i7,3f10.6)','coor',kk,coor(:,kk)
      enddo
      mult1(k)=natom1-matom1+1
      mult1(matom1+1:natom1)=natom1-matom1+1
      return
      end
