subroutine orbsym_baseloc
Use lewis_module
Use mod_script
!
!-----------------------------------------------------------------
! En entree : OL non sym dans OA non sym
! En sortie : OL sym dans OA non sym
!-----------------------------------------------------------------
!
implicit real*8 (a-h,o-x,z),logical*1(y)
character(6) at(2)
character(20) lab1,lab2
character(20),allocatable :: label_ol_tmp(:)
allocatable y(:),orbs(:,:),orbtmp(:,:)
integer cherche_at,cherche_at0
allocate(y(norb))
allocate(orbs(norb,norb))
allocate(orbtmp(norb,nsym))
allocate(label_ol0(norb))
allocate(label_ol_tmp(norb))
yw=.true.
yw=(yw.or.nprint==5).and..not.nprint==-5
orbs=0.d0
y=.false.
!
! On calcule le nombre d'OL inactives et actives
!
noac=0
ninac=noc
do i=1,norb
   if(label_OL(i)(1:1)=='A') then
      noac=noac+1
      if(occupat(i)) ninac=ninac-1
            !print*,'occu',i,occupat(i),label_ol(i)
   endif
enddo
!
! On fait une boucle sur label_ol (donc sur les orbitales locales non
! symetriques)...
!
if(yw)print*,'noc',noc
ideb=1
ifin=ninac
n=0
do icas=1,3
         !print*,'icas,ideb,ifin',icas,ideb,ifin
         !print*,'sum(nocs(1:nsym))',sum(nocs(1:nsym))
         !print*,'sum(noacs(1:nsym))',sum(noacs(1:nsym))
         !print*,'sum(ref_inac(1:nsym))',sum(ref_inac(1:nsym))
         !print*,'sum(ref_act(1:nsym))',sum(ref_act(1:nsym))
   do il=ideb,ifin
      if(y(il)) cycle
      if(ycopy2(il)) then
         n=n+1
         label_ol_tmp(n)=label_ol(il)
         cycle
      endif
      if(yw)print*,' '
      if(yw)print*,'----------------------------------'
      if(yw)print*,'Rech OL ',label_ol(il),il
      y(il)=.true.
      nequiv=1
      orbtmp(:,nequiv)=orb(:,il)
! ...Puis on cherche les orbitales equivalentes par symetrie a il
!
!           nb d'atomes de il (1 ou 2)
      nat1=(index(label_ol(il),'_',.true.)-1)/6
      lab1=label_ol(il)
      lab1(8:8)=' '
      if(nat1==2) lab1(14:14)=' '
      if(yw)print*,'lab1   ',lab1
      do il2=il+1,ifin
         if(y(il2)) cycle
         if(occact(il)/=occact(il2)) cycle
         lab2=label_ol(il2)
         lab2(8:8)=' '
         nat2=(index(label_ol(il2),'_',.true.)-1)/6
         if(yw)print*,'nat',nat1,nat2
         if(yw)print*,'lab        ',lab1,lab2
         if(nat1/=nat2) cycle
         if(nat2==2) lab2(14:14)=' '
         if(lab1==lab2) then
         if(yw)print*,' on a trouve un label equivalent',il,il2
! on a trouve un label equivalent
! on stocke l'OL dans orbtmp
            nequiv=nequiv+1
            orbtmp(:,nequiv)=orb(:,il2)
            y(il2)=.true.
         endif
      enddo
! Tous les equivalents de il sont dans orbtmp
! On va maintenant generer les OL en symetrie
      call tourne(orbs,orbtmp,nequiv,n,label_ol_tmp,il,nat1)
   enddo
   if(icas==1) then
      ideb=ninac+1
      ifin=ninac+noac
   else if(icas==2) then
      ideb=ninac+noac+1
      ifin=norb
   endif
enddo
if(yw)print*,'label_ol',label_ol
if(yw)print*,'label_ol0',label_ol0
if(yw)print*,'label_ol_tmp',label_ol_tmp
!      if(mprint(1)==1)print*,
!     *'matrice des OL sym dans la base des OA non sym'
!      if(mprint(1)==1)
!     *call mscript_lab(orbs,label,label_ol_tmp,norb,norb)
orb=orbs
label_ol=label_ol_tmp
print*,'N3'
return
end
 subroutine tourne(orbs,orbtmp,nequiv,n,label_ol_tmp,il,nat1)
Use lewis_module
Use mod_script
!
!-----------------------------------------------------------------
! Effectue la rotation entre les nequiv OL pour obtenir les combinaisons
! ++++,+-+- ...
!
! En entree : n indice courant de l'orbitale ajoutee a orbs
!-----------------------------------------------------------------
!
implicit real*8 (a-h,o-x,z),logical*1(y)
dimension orbs(norb,norb)
integer cherche_at0
dimension orbtmp(norb,norb)
character(20) label_ol_tmp(norb)
      !print*,'============='//label_ol(il)
do k=1,nequiv
   n=n+1
   do l=1,nequiv
      orbs(:,n)=orbs(:,n)+itransf(l,k)*orbtmp(:,l)
   enddo
   orbs(:,n)=orbs(:,n)/dsqrt(1.d0*nequiv)
   label_ol_tmp(n)=label_ol(il)
   label_ol_tmp(n)(7:8)=' '
   if(nat1==2) label_ol_tmp(n)(13:14)=' '
   label_ol_tmp(n)=label_ol_tmp(n)(1:2) &
   //trim(label_ol_tmp(n)(3:8)) &
   //trim(label_ol_tmp(n)(9:14)) &
   //trim(label_ol_tmp(n)(15:))
enddo
end




