      subroutine separe_pi(nwk)
      use mod_dolo
      use mod_bond
      use mod_script
      implicit real*8 (a-h,o-x,z),logical*1(y)
      common/sym/ nsym,isym(maxsym),isymt(0:maxsym)
      real(8) coo(3,2),cootmp(3)
      character(8) orbitmp
      dimension ml(1)
      character(1) x,y,z
      integer fsym2(8)
      yw=.false.
      if(yes)print*,'entree separe_pi'
      if(yw)print*,flab(iwk(1:nwk))
      do k=1,nwk
         if(yw)print*,flab(iwk(k)),atoms_in_LO(iwk(k),1)
     *   ,atoms_in_LO(iwk(k),2)
      enddo
! coord des atomes
      do k=1,natom
         if(yw)print'(a,i4,2x,a,2x,3f10.6)','atomes',k,atom(k),coor(:,k)
         if(atom(k)==atoms_in_LO(iwk(1),1)) coo(:,1)=coor(:,k)
         if(atom(k)==atoms_in_LO(iwk(1),2)) coo(:,2)=coor(:,k)
      enddo
      if(yw)call mscript(coo)
      nop=0
      if(nsym==2) nop=1
      if(nsym==4) nop=2
      if(nsym==8) nop=3
 
      if(yw)print*,'nop',nop
      if(yw)print*,'sym1',sym1(1:msym)
! Les 2 atomes sont-ils les plus proches ?
      call caldist(d,coo(:,1),coo(:,2),cootmp,msym,sym1,yangstrom,idum)
      if(yw)call mscript(coo)
      if(yw)print*,'cootmp',cootmp
      coo(:,1)=cootmp
      if(yw)print*,'coordonnees des atomes les plus proches'
      if(yw)call mscript(coo)
! vecteur coo(:,1) -- coo(:,2)
      cootmp=coo(:,1)-coo(:,2)
      if(yw)print*,'vecteur de la liaison'
      if(yw)print*,'cootmp',cootmp
! Plus grande direction
      ml=maxloc(abs(cootmp))
      if(ml(1)==1) then
         if(yw)print*,'La plus grande direction de la liaison est X'
         x='X'
         y='Y'
         z='Z'
      else if(ml(1)==2) then
         if(yw)print*,'La plus grande direction de la liaison est Y'
         x='Y'
         y='X'
         z='Z'
      else if(ml(1)==3) then
         if(yw)print*,'La plus grande direction de la liaison est Z'
         x='Z'
         y='Y'
         z='X'
      endif
! Rotations :
!   Paires d'orbitales a tourner
      if(yw) then
         print*,'Paires d''orbitales a tourner'
         do k=1,nwk
            if(index(flab(iwk(k)),'.SP')/=0) print*,iwk(k),flab(iwk(k)),
     *      focvir(iwk(k)),fsym(iwk(k))
         enddo
      endif
      yrot=.false.
      do k=1,nwk
         do l=k+1,nwk
            if(index(flab(iwk(k)),'.SP')/=0) then
               if(index(flab(iwk(l)),'.SP')/=0) then
                  if(focvir(iwk(k))==focvir(iwk(l)).and.
     *            fsym(iwk(k))==fsym(iwk(l))) then
                      if(yw)print*,iwk(k),iwk(l),flab(iwk(k)),
     *                focvir(iwk(k)),fsym(iwk(k))
                      call separe_pi_rot(x,y,z,k,l)
                      yrot=.true.
                  endif
               endif
            endif
         enddo
      enddo
      if(.not.yrot) then
! Aucune orb n'a ete tournee
! Cela veut dire qu'on n'a pas trouve de paires d'orbitales
! La liaison est donc sur un axe de symetrie
! On va renommer les liaisons en fonction des occupations px,py ou pz
         do k=1,nwk
            if(index(flab(iwk(k)),'.SP')/=0) then
               aa=0.d0
               do l=1,norb
                  orbitmp=orbi(l)
                  call maj(orbitmp,8)
                  if(orbitmp(5:6)=='2P') then
                     ll=len_trim(flab(iwk(k)))
                     if(abs(flo(l,iwk(k)))>aa) flab(iwk(k))(ll-1:ll)=
     *               orbitmp(6:7)
                  endif
               enddo
            endif
         enddo
      endif
      return
      end
       subroutine separe_pi_rot(x,y,z,k,l)
      use mod_dolo
      use mod_bond
      use mod_script
      implicit real*8 (a-h,o-x,z),logical*1(y)
      character(1) x,y,z
      character(8) orbitmp
      yw=.false.
      if(yw) then
         print*,'orbitales a tourner',iwk(k),iwk(l)
         do i=1,norb
            if(any(abs(flo(i,(/iwk(k),iwk(l)/)))>1.d-3))
     *      print'(i4,3x,a,2f8.4)',i,orbi(i),flo(i,iwk(k)),flo(i,iwk(l))
         enddo
      endif
      aa=0.d0
      ii=0
! On met Py a zero dans iwk(k)
      do i=1,norb
         orbitmp=orbi(i)
         call maj(orbitmp,8)
         if(index(orbitmp,'2P'//y)/=0) then
            bb=flo(i,iwk(k))**2+flo(i,iwk(l))**2
            if(bb>aa) then
               ii=i
               aa=bb
            endif
         endif
      enddo
      if(ii==0) stop'separe_pi_rot vecteur nul'
      if(yw)print*,'plus grand coef',ii,aa
! Rotation
      cosinus=flo(ii,iwk(l))/sqrt((flo(ii,iwk(k))**2+flo(ii,iwk(l))**2))
      sinus=-flo(ii,iwk(k))/sqrt((flo(ii,iwk(k))**2+flo(ii,iwk(l))**2))
      do i=1,norb
         aa=flo(i,iwk(k))
         flo(i,iwk(k))=cosinus*flo(i,iwk(k))+sinus*flo(i,iwk(l))
         flo(i,iwk(l))=sinus*aa-cosinus*flo(i,iwk(l))
         ll=len_trim(flab(iwk(k)))
      enddo
      if(yw)print*,'FLAB1',iwk(k),iwk(l), flab(iwk(k)),flab(iwk(l))
      flab(iwk(k))(ll-1:ll)='P'//z
      flab(iwk(l))(ll-1:ll)='P'//y
      if(yw)print*,'FLAB2',iwk(k),iwk(l), flab(iwk(k)),flab(iwk(l))
      if(yw) then
         print*,'orbitales tournees'
         do i=1,norb
            if(any(abs(flo(i,(/iwk(k),iwk(l)/)))>1.d-3))
     *      print'(i4,3x,a,2f8.4)',i,orbi(i),flo(i,iwk(k)),flo(i,iwk(l))
         enddo
      endif
      if(yes)print*,'sortie separe_pi'
      return
      end
