subroutine occupation_atomes(atom0,natom0,prefix,liste_multat2)
character(4) atom0(natom0),atom1
character(1000) aa
character(3) occ
character(*) prefix
integer :: liste_multat2(natom0)
logical :: yw=.false.
call titre('Occupation des atomes#',50)

open(99,file=trim(prefix)//'LOinfo',status='unknown')
open(98,file=trim(prefix)//'FROZDELinfo',status='unknown')
read(99,*) norb
if(yw)print*,'norb',norb
do i=1,natom0
   rewind 99
   rewind 98
   read(99,*)
   nel=0
   nact=0
   do j=1,norb
      aa=' '
      read(99,'(28x,a3,13x,i3,a1000)',end=1) OCC,mult,aa
      if(yw)print*,OCC,' | ',mult,' | ',trim(aa),' | ',atom0(i), &
      index(aa,atom0(i))
      if(index(aa,atom0(i))>0) then
         if(occ=='OCC') then
            nel=nel+2/mult
         else if(occ=='ACT') then
            nact=nact+1
         endif
      endif
   enddo
1        continue
   do j=1,norb
      aa=' '
      read(98,'(28x,a3,13x,i3,a1000)',end=2) OCC,mult,aa
      if(yw)print*,OCC,' | ',mult,' | ',trim(aa),' | ',atom0(i), &
      index(aa,atom0(i))
      if(index(aa,atom0(i))>0) then
         if(occ=='OCC') then
            nel=nel+2/mult
         else if(occ=='ACT') then
            nact=nact+1
         endif
      endif
   enddo
2        continue
   if(liste_multat2(i)==1) aa=' atome)'
   if(liste_multat2(i)>1) aa=' atomes)'
   if(nact==0) then
      print'(a,i5,a,i1,a)', &
      atom0(i),nel,'     (',liste_multat2(i),trim(aa)
   else
      print'(a,i5,a,i4,a,a,i1,a)', &
      atom0(i),nel,' +',nact,' actives = ????', &
      '     (',liste_multat2(i),trim(aa)
   endif
enddo
close(99)

end

