subroutine occbf(CR,CI,nmax,nb,n0,n14,bl,ml,ss,nn)
      implicit none
      integer*4 nmax,j,i,nb,it,ia,ig,n0,n14,bl(n0,n14),ml(n0,n14),nn
      real*8 CR(*),CI(*),a,t,ss(n0,n14)
      real*8,allocatable::occ(:)
      integer*4 ,allocatable::icc(:)

      allocate(occ(nb),icc(nb))
      do 1 i=1,nb
      occ(i)=0.0d0
      icc(i)=i
      do 1 J=1,nmax
1     occ(i)=occ(i)+CR(i+nb*(J-1))**2+CI(i+nb*(J-1))**2

      do 2 i=1,nb
      a=occ(i)
      ia=i
      do 21 j=i+1,nb
      if(occ(j).gt.a)then
       a=occ(j)
       ia=j
      endif
21    continue
      t=occ(ia)
      occ(ia)=occ(i)
      occ(i)=t
      it=icc(ia)
      icc(ia)=icc(i)
2     icc(i)=it

      write(6,601)1,nmax
601   format(/,' Basis set participation between eigenvalues ',
     1i1,' -',i5,':',/,' # basis part (%):')
      do 3 i=1,nb
3     if(occ(i).gt.0.01d0)write(6,600)i,icc(i),occ(i)*100.0d0
600   format(2i5,f12.4,' %')

c     write refined basis set:
      open(9,file='pauli.ref.txt')
      ig=0
      do 4 i=1,nb
      if(occ(i).gt.0.01d0)then
       ig=ig+1
       it=icc(i)
       write(9,901)bl(it,1),ml(it,1),ss(it,1)
901    format(i3,i4,f6.1,$)
       do 5 j=2,nn
5      write(9,900)bl(it,j),ml(it,j),ss(it,j)
900    format(2i4,f6.1,$)       
       write(9,*)
      endif
4     continue
      close(9)
      write(6,*)' pauli.ref.txt written,',ig,' functions'
      return
      end