      subroutine symetrie
      use mod_dolo
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      common/pr/nprint
      character*1280 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(k)
      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(k)
      use mod_dolo
!
!-----------------------------------------------------------
! Generation par symetrie des atomes
!
! 1er passage :
! en entree : natom1=nb d'atomes donnes, ou aucun ne se
!             correspond par symetrie
!             k numero de l'atome dont on genere les equivalents
!             par symetrie
! en sortie : natom1 a ete incremente des symetriques de k
!
! autres passages :
! en entree : natom1=nb d'atomes donnes + ceux deja
!             generes par symetrie
! en sortie : natom1 a ete incremente des symetriques de k
!
! mult1 : pour chaque atome, sa multiplicite par symetrie
!-----------------------------------------------------------
!
      IMPLICIT REAL*8(A-H,O-X,Z),logical*1(y)
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      logical y,yw
      dimension coor1(3),coor2(3)
      yw=.false.
      if(yw)print*,'entree gsatom'
! On stocke dans coor2 les coordonnees de k
      matom1=natom1
      coor2=coor(:,k)
      if(yw)print*,'natom1,k,msym',natom1,k,msym
      do is=1,msym
         coor1=coor2
! On genere dans coor1 un symetrique de k
         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*,'coor1',coor1
         if(yw)print*,'coor2',coor2
         if(yw)print*,'ANORM2',anorm2,'   sym1(is)',sym1(is)
! si anorm2==0, le symetrique de k est le meme que k
         if(anorm2<1.d-6) cycle
         y=.false.
         if(yw)print*,'matom1+1,natom1',matom1+1,natom1
! On cherche si le symetrique de k genere a deja ete genere
! par un is precedent
         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))
! si anorm2==0, le symetrique de k a deje ete genere
            if(anorm2<1.d-6) y=.true.
         enddo
         if(y) cycle
! le symetrique de k que is a genere est nouveau
         natom1=natom1+1
         coor(:,natom1)=coor1
         atom(natom1)=atom(k)
         print'(a,i3,2x,a,3f8.4)','Genere :',natom1,atom(natom1),coor1
      enddo
      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
      if(yw)print*,'sortie gsatom'
      return
      end
