      subroutine locsym(oo,lb,yx,yy,yz,yyx,yyy,yyz)
      use module
      use mod_script
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension oo(noa,noa)
      dimension dp(8),mu(8),m(1)
      allocatable ol(:)
      allocatable imoa(:,:),imat(:,:),jmoa(:,:)!,lbas(:,:)
     *,imoas(:,:),ss(:,:)
      dimension yx(3),yy(3),yz(3)
      dimension yyx(8),yyy(8),yyz(8)
      dimension coor2(3,8),coor3(3),jmat(8)
      character(10),dimension(:),allocatable :: orbi2
      character(10) orbi3
      character(80) ccc
      integer,dimension(:,:),allocatable :: isgnxyz
      dimension isgnxyz0(3)
      dimension lb(natom0)
      character(100000) namel
      character(3)  oper(8)
      yw=.false.
      yw1=nprint>0
      allocate(jmoa(noa,nsym))
      allocate(ol(noa))
      do k=1,norb
         if(yw)print*,'tipo_l',k,tipo_l(k)
      enddo
      if(yw)print*,'isymng',isymng
      !
      !---------------------------------------------------------------
      ! Symetrie des orbitales (Calcul de ITSYML)
      !
      ! une orbitale peut, par rapport a une operation de symetrie (3
      ! operations au max (x,y,z pour D2h par ex)
      ! - etre invariante
      ! - se transformer en une autre orbitale
      ! dans le 2eme cas, elle peut etre :
      ! - principale (arbitrairement la premiere de la liste)
      ! - secondaire
      ! par rapport a une operation de symetrie, l'orb peut avoir la
      ! valeur repere :
      ! 2 : orbitale principale
      ! -2 : orbitale secondaire
      ! 1 invariante
      ! -1 transformee en -(elle-meme)
      ! la "symetrie" de l'orbitale est donnee par plusieurs valeurs
      ! (une par operation de symetrie) qui sont stockees dans itsyml
      ! ex : D2h orb i, de sym itsyml(i,1:3)=2,-2,-1
      ! signifie :  i est principale /x, secondaire /y, anti-sym /z
      !
      ! l'objet de cette subroutine est de calculer itsyml pour chaque
      ! orbitale
      !----------------------------------------------------------------
      !
!
! Coordonnees des atomes equivalents
!
      if(yw1)
     *print*,'Coordonnees des atomes equivalents, calcul isgnxyz0'
      if(yw1)
     *print*,'(isgnxyz0 est simplement le signe de la coordonnee)'
      if(yw1)print*,' '
      if(yw1)print*,
     *'   iat  iop   n   ----------coord-----------   isgnxyz0 ATOM'
      if(yw1)print*,
     *'                 /                          \  X  Y  Z      '
      ifin=0
      jmoa=0
      n=0
      allocate(isgnxyz(3,noa))
      nisgn=0
      if(yw) then
         do iat=1,natom0
            print*,'lb',iat,'  ',atom0(iat),lb(iat)
         enddo
      endif
      do iat=1,natom0
         ideb=ifin+1
         ifin=ifin+lb(iat)
         jmat=0
         coor2=0.d0
         ifin1=0
         do iop=1,2**nop
            coor3=coor(:,iat)
            if(yyx(iop)) coor3(1)=-coor3(1)
            if(yyy(iop)) coor3(2)=-coor3(2)
            if(yyz(iop)) coor3(3)=-coor3(3)
            !print*,'iop,coor3',iop,coor3
            ydeja=.false.
            do jop=1,iop-1
               if(all(coor3==coor2(:,jop))) then
                  ydeja=.true.
                  !jmat(iop)=jop
                  !print*,iop,jop,ydeja
                  exit
               endif
            enddo
            !if(yw.and.ydeja) print*,'cycle'
            if(ydeja) cycle
            do k=1,3
               if(abs(coor3(k))<1.d-6) then
                  isgnxyz0(k)=0
               else
                  if(coor3(k)>0.d0) then
                     isgnxyz0(k)=1
                  else
                     isgnxyz0(k)=-1
                  endif
               endif
            enddo
            ideb1=ifin1+1
            ifin1=ifin1+lb(iat)
            n=n+1
            do k=1,lb(iat)
               nisgn=nisgn+1
               isgnxyz(:,nisgn)=isgnxyz0
            enddo
            coor2(:,iop)=coor3
            if(yw1)print'(a,3i5,3f10.6,3i3,2x,a)',' ',iat,iop,n,coor3,
     *      isgnxyz0,atom0(iat)
         enddo
      enddo
      if(yw1) print*,' '
      if(yw1) print*,' '
C!
C! longueur de la base pour un atome et une symetrie (lbas)
C! lbas(1,2)=3 : pour l'atome 1 (liste courte), dans la symetrie 2,
C! il y a trois OA non nulles
C!
      allocate(orbi2(noa))
C      rewind 1
C      namel=' '
C      call LECNAM('&COST_AO',namel,1,ierr,0)
C      call namela(namel,ORBI2,'LABEL')
C      allocate(lbas(natom0,nsym))
C      lbas=0
C      do iat=1,natom0
C         ii=0
C         do is=1,nsym
C            do io=1,isym(is)
C               ii=ii+1
C               if(atom0(iat)/=orbi2(ii)(1:4)) cycle
C               lbas(iat,is)=lbas(iat,is)+1
C            enddo
C         enddo
C      enddo
C      if(yw) then
C         do iat=1,natom0
C            print*,'lbas  ',atom0(iat),lbas(iat,:)
C         enddo
C      endif
      
!
! definition totale des OA
!
      orbi2=' '
      orbi2(:)(1:8)=orbi
      j=0
      if(yw)print*,'definition totale des OA'
      do iat=1,natom0
         do mm=1,multat(iat)
            j0=j
            do l=1,lb(iat)
               j=j+1
               i=1
               do k=j0+1,j-1
                  if(orbi(j)==orbi(k)) then
                     i=i+1
                  endif
               enddo
               write(orbi2(j)(9:10),'(i2)') i
               if(yw)print'(''OA '',a,5i5,3x,a)',atom0(iat),iat,mm,l,j,i
     *         ,orbi2(j)
            enddo
         enddo
      enddo
      if(yw) then
         print*,'isgnxyz est le signe des coord de l''OL'
         do k=1,noa
            print'(a,i7,3x,2a,3i3)','isgnxyz   ',k
     *      ,orbi2(k),'   ',isgnxyz(:,k)
         enddo
      endif
!
! images des OA
!
      allocate(imoa(noa,nop))
      allocate(imoas(noa,nop))
      imoa=0
      ! On prend une OA k...
      do k=1,noa
!         if(index('SPDF',orbi(k)(6:6))==0.and. nsym .gt. 1) then
!            print*,'subroutine locsym: seules les orbitales S,P,D,F,'//
!     *      ' sont programmees pour l''instant'
!            stop
!         endif
         orbi3=orbi2(k)
         !... on la transforme par l'operation iop
         do iop=1,nop
            isgnxyz0=isgnxyz(:,k)
            if(yw)print'(a,2i3,4x,3i3)','k,iop',k,iop,isgnxyz(:,k)
            if(yw)print'(2a,3i4)','A    ',orbi3,isgnxyz0
            if(yx(iop)) then
               isgnxyz0(1)=-isgnxyz0(1)
            endif
            if(yy(iop)) then
               isgnxyz0(2)=-isgnxyz0(2)
            endif
            if(yz(iop)) then
               isgnxyz0(3)=-isgnxyz0(3)
            endif
            if(yw)print'(2a,3i4)','B    ',orbi3,isgnxyz0
            !...on cherche parmi les OA precedentes en quelle OA l
            ! l'OA k s'est transformee
            do l=1,k
               if(orbi2(l)==orbi3) then
                  if(all(isgnxyz0==isgnxyz(:,l))) then
                     if(yw)print*,'trouve l',l
                     imoa(k,iop)=l
                     imoa(l,iop)=k
                     call isgnoa(orbi(k)(5:8),yx,yy,yz,iop,isgn)
                     if(yw)print*,'isgn',isgn
                     imoas(k,iop)=isgn
                     imoas(l,iop)=isgn
                  endif
               endif
            enddo
         enddo
      enddo
      if(yw) then
         print*,'IMOA*IMOAS'
         do k=1,noa
            print*,k,orbi(k),'  ',imoa(k,1:nop)*imoas(k,1:nop)
         enddo
      endif
      if(nsym>1) then
         if(yw1)print*,'image des OA par les transformations'
         if(yw1)print*,
     *   '    OA        numeros OA equivalentes'
         do k=1,noa
!            if(yw1)print'(i6,4x,a,2(a,6x),8i6)',
!     *      k,orbi2(imoa(k,1)),('.',kk=1,3-nop)
!     *      ,imoa(k,:)*imoas(k,:)
            if(yw1)print'(i6,4x,8i6)',
     *      k
     *      ,imoa(k,:)*imoas(k,:)
!            if(yw1)print'(i6,4x,a,6x,8i6)',
!     *      k,orbi2(imoa(k,1))
!     *      ,imoa(k,:)*imoas(k,:)
         enddo
      endif
!
! OL equivalentes par symetrie
!
      nequiv=0
      itsyml=0
      ! on lit la matrice de recouvrement entre OA desymetrisees
      allocate(ss(noa,noa))
      open(99,form='unformatted',status='old',file='DESYMORB2')
      read(99)
      read(99)
      read(99)
      read(99) ss
      close(99)
      ! boucle sur les OL
      do iol=1,norb
         ! on va prendre les OL par classes
         nequiv=nequiv+1
         y=iol==norb
         if(.not.y) y=tipo_l(iol+1)/=tipo_l(iol)
         if(y) then
            ! si on arrive ici,
            ! on a fini de trouver toutes les OL d'une classe
            ! il y en a nequiv
            !
            ! transformation de la 1ere OL de la classe
            if(yw)print*,' '
            if(yw)print'(a,i5,4x,a,i3,a)','OL',
     *      iol,tipo_l(iol),nequiv,' orb equiv'
            ! boucle sur les orbitales de la classe
            do jol=iol-nequiv+1,iol
               ! on la transforme par l'operation iop
               do iop=1,nop
                  if(yw)print*,'jol,iop,nequiv',jol,iop,nequiv
                  if(yw)print'(a)','transf orb'
                  if(yw)print*,'               OL ref   OL transf |'
     *            //'    A comparer a :'
                  if(yw)print*,'                          par iop |'
                  do k=1,noa
                     ol(k)=oo(imoa(k,iop),jol)*imoas(k,iop)
                     if(yw)print'(a,i4,2f10.6,2h |,8f8.4)',
     *               orbi(k)//'  ',k,oo(k,jol),ol(k),
     *               oo(k,iol-nequiv+1:iol)
                  enddo
                  !print*,'ol'
                  !call script(ol,noa,1,noa,1)
                  !print*,'oo'
                  !call mscript(oo(:,iol-nequiv+1:iol))
                  ! En quelle orb se transforme-t-elle ?
                  do kol=iol-nequiv+1,iol
                     dop=dot_product(ol,matmul(ss,oo(:,kol)))
                     if(yw)print'(a,i5,3f10.6)','prod scalaire',kol,d
     &               op
                     if(abs(abs(dop)-1.d0)<1.d-2) then
                        ! L'orb jol se transforme en kol par iop
                        if(dop<0) itsyml(jol,iop)=-1
                        if(dop>0) itsyml(jol,iop)=1
                        if(kol==jol) then
                           princl(jol,iop)=1
                        else
                           if(jol>kol) princl(jol,iop)=2
                           if(jol<kol) princl(jol,iop)=-2
                           ! Changement de phase de l'OL, si dop==-1
                           if(dop<0.d0) then
                              print*,'locsym2 orb',jol,
     *                        '  changement de phase'
                              oo(:,jol)=-oo(:,jol)
                              itsyml(jol,iop)=-itsyml(jol,iop)
                           endif
                          !print'(a,i4,a,a,2i4,a,i4,a,f10.6,a,2i4)',
     *                     !'classe',iol,'   '//trim(tipo_l(iol)),
     *                     !'  equiv',jol,kol,
     *                     !' itsyml',itsyml(jol,iop),' dop',dop
     *                     !,' princl',princl(jol,iop)
                        endif
                     endif
                  enddo
               enddo
            enddo
            nequiv=0
         endif
      enddo
!     A ce niveau, itsyml(jol,iop) est le signe de la tranformation
!     de l'OL jol sous l'operation iop. Les operations sont celles
!     donnees dans SYMM (3 au maximum)
!     on etend itsyml aux autres operations, produits des operations
!     donnees (il y en a nsym-1)
      if(nsym==4) then
         itsyml(:,3)=itsyml(:,1)*itsyml(:,2)
      else if(nsym==8) then
         ! L'operation 4 est la 3eme donnee :
         itsyml(:,4)=itsyml(:,3)
         ! Les autres operations sont des produits (voir dans symmsim
         ! pour l'ordre :
         itsyml(:,3)=itsyml(:,1)*itsyml(:,2)
         itsyml(:,5)=itsyml(:,1)*itsyml(:,4)
         itsyml(:,6)=itsyml(:,2)*itsyml(:,4)
         itsyml(:,7)=itsyml(:,2)*itsyml(:,5)
      ENDIF
      if(yw) then
         print*,'princl'
         call mscript(princl)
         print*,'itsyml'
         call mscript(itsyml)
      endif
      if(nsym>1) then
         if(nprint>0) call titre('Symetrie des orbitales locales'//
     *   ' par rapport aux operations de symetrie#',40)
         call symmsim(symm_sew,oper,nsym)
         if(nprint>0) then
            print*,'Princ :'
            print*,' 1 : l''OL est invariante'
            print*,' 2 : l''OL est "principale" (arbitrairement '//
     *      'la derniere de sa classe)'
            print*,'-2 : l''OL est "secondaire"'
            print*,'Sym : signe de l''OL apres transformation par '
     *      //'l''operation iop'
            print*,' '
            print*,'      Loc Orb.           Princ         Sym'
            ccc=' '
            write(ccc(28:28+nop*3-1),'(3a3)') oper(2:nop+1)
            write(ccc(42:42+(nsym-1)*3-1),'(8a3)') oper(2:nsym)
            print'(a)',trim(ccc)
            do k=1,norb
               if(tipo_l(k)(1:1)=='T'.and.nprint==0) exit
               ccc=' '
               write(ccc,'(i4,2a)') k,'   ',tipo_l(k)
               write(ccc(26:),'(3i3)') princl(k,1:nop)
               write(ccc(40:),'(7i3)') itsyml(k,1:nsym-1)
               print'(a)', trim(ccc)
            enddo
         endif
      endif
      return
      end
      subroutine isgnoa(orbi,yx,yy,yz,iop,isgn)
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      character(4) orbi
      dimension yx(3),yy(3),yz(3)
      yw=.false.
      isgn=1
      if(yw)print*,'isgnoa',orbi,yx(iop),yy(iop),yz(iop)
      if(yx(iop)) then
         if(orbi=='2PX ') isgn=-isgn
         if(orbi(3:4)=='1+') isgn=-isgn
         if(orbi(3:4)=='3+') isgn=-isgn
         if(orbi(3:4)=='5+') isgn=-isgn
         if(orbi(3:4)=='7+') isgn=-isgn
         if(orbi(3:4)=='2-') isgn=-isgn
         if(orbi(3:4)=='4-') isgn=-isgn
         if(orbi(3:4)=='6-') isgn=-isgn
      endif
      if(yy(iop)) then
         if(orbi=='2PY ') isgn=-isgn
         if(orbi(4:4)=='-') isgn=-isgn
      endif
      if(yz(iop)) then
         if(orbi=='2PZ ') isgn=-isgn
         if(orbi=='3D1+') isgn=-isgn
         if(orbi=='3D1-') isgn=-isgn
         if(orbi=='4F2+') isgn=-isgn
         if(orbi=='4F0 ') isgn=-isgn
         if(orbi=='4F2-') isgn=-isgn
         if(orbi=='5G3+') isgn=-isgn
         if(orbi=='5G1+') isgn=-isgn
         if(orbi=='5G1-') isgn=-isgn
         if(orbi=='5G3-') isgn=-isgn
         if(orbi=='6H4+') isgn=-isgn
         if(orbi=='6H2+') isgn=-isgn
         if(orbi=='6H0 ') isgn=-isgn
         if(orbi=='6H2-') isgn=-isgn
         if(orbi=='6H4-') isgn=-isgn
         if(orbi=='7I5+') isgn=-isgn
         if(orbi=='7I3+') isgn=-isgn
         if(orbi=='7I1+') isgn=-isgn
         if(orbi=='7I1-') isgn=-isgn
         if(orbi=='7I3-') isgn=-isgn
         if(orbi=='7I5-') isgn=-isgn
      endif
      return
      end
      subroutine calyyop(nop,yx,yy,yz,yyx,yyy,yyz)
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension yx(3),yy(3),yz(3)
      dimension yyx(8),yyy(8),yyz(8)
      yyx(1)=.false.
      yyy(1)=.false.
      yyz(1)=.false.
      if(nop==0) return
      yyx(2)=yx(1)
      yyy(2)=yy(1)
      yyz(2)=yz(1)
      if(nop==1) return
      yyx(3)=yx(2)
      yyy(3)=yy(2)
      yyz(3)=yz(2)
      yyx(4)=(yyx(2).or.yyx(3)).and..not.(yyx(2).and.yyx(3))
      yyy(4)=(yyy(2).or.yyy(3)).and..not.(yyy(2).and.yyy(3))
      yyz(4)=(yyz(2).or.yyz(3)).and..not.(yyz(2).and.yyz(3))
      if(nop==2) return
      yyx(5)=yx(3)
      yyy(5)=yy(3)
      yyz(5)=yz(3)
      yyx(6)=(yyx(2).or.yyx(5)).and..not.(yyx(2).and.yyx(5))
      yyy(6)=(yyy(2).or.yyy(5)).and..not.(yyy(2).and.yyy(5))
      yyz(6)=(yyz(2).or.yyz(5)).and..not.(yyz(2).and.yyz(5))
      yyx(7)=(yyx(3).or.yyx(5)).and..not.(yyx(3).and.yyx(5))
      yyy(7)=(yyy(3).or.yyy(5)).and..not.(yyy(3).and.yyy(5))
      yyz(7)=(yyz(3).or.yyz(5)).and..not.(yyz(3).and.yyz(5))
      yyx(8)=yyx(2).or.yyx(3).or.yyx(5)
      yyx(8)=yyx(8).and..not.(yyx(2).and.yyx(3))
      yyx(8)=yyx(8).and..not.(yyx(2).and.yyx(5))
      yyx(8)=yyx(8).and..not.(yyx(3).and.yyx(5))
      yyx(8)=yyx(8).or.(yyx(2).and.yyx(3).and.yyx(5))
      yyy(8)=yyy(2).or.yyy(3).or.yyy(5)
      yyy(8)=yyy(8).and..not.(yyy(2).and.yyy(3))
      yyy(8)=yyy(8).and..not.(yyy(2).and.yyy(5))
      yyy(8)=yyy(8).and..not.(yyy(3).and.yyy(5))
      yyy(8)=yyy(8).or.(yyy(2).and.yyy(3).and.yyy(5))
      yyz(8)=yyz(2).or.yyz(3).or.yyz(5)
      yyz(8)=yyz(8).and..not.(yyz(2).and.yyz(3))
      yyz(8)=yyz(8).and..not.(yyz(2).and.yyz(5))
      yyz(8)=yyz(8).and..not.(yyz(3).and.yyz(5))
      yyz(8)=yyz(8).or.(yyz(2).and.yyz(3).and.yyz(5))
      return
      end
      subroutine locsym0(lb,yx,yy,yz,yyx,yyy,yyz)
      use module
      use mod_script
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension yx(3),yy(3),yz(3)
      dimension yyx(8),yyy(8),yyz(8)
      dimension lb(natom0)
      character(80) symm
      character(3),allocatable :: oper(:)
      character(100000) namel
      integer itransf(8,8)
!
      yw=.false.
      itransf(1,:)=(/1, 1, 1, 1, 1, 1, 1, 1/)
      itransf(2,:)=(/1,-1, 1,-1, 1,-1, 1,-1/)
      itransf(3,:)=(/1, 1,-1,-1, 1, 1,-1,-1/)
      itransf(4,:)=(/1,-1,-1, 1, 1,-1,-1, 1/)
      itransf(5,:)=(/1, 1, 1, 1,-1,-1,-1,-1/)
      itransf(6,:)=(/1,-1, 1,-1,-1, 1,-1, 1/)
      itransf(7,:)=(/1, 1,-1,-1,-1,-1, 1, 1/)
      itransf(8,:)=(/1,-1,-1, 1,-1, 1, 1,-1/)
!
!-----------------------------------------------
! lecture donnees symm (operations de symetrie)
!-----------------------------------------------
!
      call titre('Symetrie des orbitales#',40)
      rewind 93
      symm='SEWARD'
      call LECNAM('&IJKLOC ',namel,93,ierr,0)
      call namela(namel,SYMM,'SYMM')

      if(nsym>1) then
         if(symm=='SEWARD') then
            ! symm n'a pas ete trouve. On le cherche dans Info
            rewind 1
            call LECNAM('&COST_AO ',namel,1,ierr,0)
            call namela(namel,SYMM,'SYMM')
            if(symm=='SEWARD') then
              ! symm n'a toujours pas ete trouve. On le cherche dans &SEWARD
               rewind 93
               call LECNAM('&SEWARD ',namel,93,ierr,0)
               if(ierr==1) then
                  print*,'symm n''a pas ete trouve '
                  stop
               endif
               do
                  read(93,'(a20)') symm
                  symm=adjustl(symm)
                  call maj(symm,20)
                  if(symm(1:4)=='SYMM') then
                     read(93,'(a20)') symm
                     exit
                  endif
                  if(symm(1:3)=='END') exit
               enddo
            endif
         endif
      else
         symm=' '
      endif
      if(nsym==1) itest(1)=0
      l=len_trim(symm)
      if(l>0) then
         call suppdb(symm,l)
         l=len_trim(symm)
         call maj(symm,l)
         if(yw) print*,'symm',symm
      endif
      if(nsym>1) print*,'Operations de Symetrie    ',trim(symm)
      symm_sew=symm
!
!----------------------------------------------------------------
! calcul de yx, yy, yz
! yx(operation)=T  <==> l'operation contient X (ex 2PX, 3D1+...)
!----------------------------------------------------------------
!
      nop=0
      if(l>0) nop=1
      do k=1,l
         if(symm(k:k)==' ') nop=nop+1
      enddo
      if(yw) print*,'nop',nop
      if(nop>0) then
         allocate(oper(0:2**nop-1))
         call symmsim(symm,oper,nsym)
         if(nsym==8) oper(3)=oper(4)
!         do k=1,nop
!            i=index(symm,' ')
!            oper(k)=symm(1:i-1)
!            symm(1:i-1)=' '
!            symm=adjustl(symm)
!         enddo
         do k=1,nop
            if(yw)print*,'oper',k,oper(k)
            if(yw)print*,'symm',symm
         enddo
!         call transfosim(oper,nsym,itransf)
!         do k=1,nop
!            if(yw)print*,'oper apres transfosim',k,oper(k)
!         enddo
         do k=1,nop
            yx(k)=index(oper(k),'X')/=0
            yy(k)=index(oper(k),'Y')/=0
            yz(k)=index(oper(k),'Z')/=0
         enddo
         if(yw)print*,'yx(1:nop)',yx(1:nop)
         if(yw)print*,'yy(1:nop)',yy(1:nop)
         if(yw)print*,'yz(1:nop)',yz(1:nop)
      endif
!
!----------------------------------------------------------------
! calcul de yyx, yyy, yyz
! yx(operation==T  <==> l'operation contient X (ex 2PX, 3D1+...)
!----------------------------------------------------------------
!
      call calyyop(nop,yx,yy,yz,yyx,yyy,yyz)
      if(yw)print*,'yyx(1:2**nop)',yyx(1:2**nop)
      if(yw)print*,'yyy(1:2**nop)',yyy(1:2**nop)
      if(yw)print*,'yyz(1:2**nop)',yyz(1:2**nop)
!
!     Transformations et symetries de OA
!
      if(yw) then
         do k=1,noa
            print*,'orbi',k,orbi(k)
         enddo
      endif
!
! Multiplicite des atomes
!
      do iat=1,natom0
         n=0
         do iop=1,nop
            yautre=(yx(iop).and.abs(coor(1,iat))>1.d-6)
     *      .or.(yy(iop).and.abs(coor(2,iat))>1.d-6)
     *      .or.(yz(iop).and.abs(coor(3,iat))>1.d-6)
            if(yautre) n=n+1
         enddo
         multat(iat)=2**n
      enddo
      call multipat(coor,symm,natom0,multat)
!
! Longueur de la base d'OA des atomes
!
      i=1
      do iat=1,natom0
         n=0
         do k=1,noa
            if(orbi(k)(1:4)==atom0(iat)) then
               n=n+1
            else
               i=k
            endif
         enddo
         lb(iat)=n/multat(iat)
!         write(75,*)'multiplicite de l''atome : ',atom0(iat),multat(i
!     &   at)
!     *   ,'.........  longueur de la base',lb(iat),'$'
!         call scril
      enddo
      return
      end
