      subroutine fainumac
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxorb=1024,nsymz=8)
      parameter(maxorbcas=16)
      common/occsy/numacsy(8),ninacsy(8)
      common/occ/noac,nelac,numac(maxorbcas),is0,ninac,nvirt
     *,numt(maxorb),nump(maxorb),ntac,nutac(maxorbcas),ms2
      common/sym/nsym,its(nsymz,nsymz),itsym(maxorb)
      common/f4/norb,noc,noca,nocb,nca0,ncb0,ydet,ydetv,ydetcl
     *,ydetsc,yf_act,ywcas,ynosym,ytp0
      dimension ninacsy_fermi(8),numacsy_occ(8),numacsy_vir(8)
      dimension ninacsy_aj(8)
      integer frozen(8)
      character*10000 namel
      
c
c On lit frozen
c
      rewind 45
      call LECNAM('&COST_MO',namel,45,ierr,0)
c      namelist /ij/nsym,norb,noc,itsym,its
      call nameli(namel,FROZEN,'FROZEN',4)
c
c Verification des donnees
c
      if(noac.eq.0) return
      do i=1,noac
         if(numac(i).ne.0) return
      enddo
      print*,' '
      print*,'----------------------------------------------'
      print*,'numac n''est pas donne'
      print*,'il est calcule a partir de nincasy et numacsy'
      print*,' '
      write(75,*)'Ninacsy=',(ninacsy(k),k=1,nsym),'$'
      call scril
      write(75,*)'Numacsy=',(Numacsy(k),k=1,nsym),'$'
      call scril
      n=0
      print*,' '
      do i=1,nsym
         n=n+numacsy(i)
      enddo
      if(n.ne.noac) then
         print*,' '
         print*,'*******************************************'
         print*,'NUMAC n''est pas donne, '
         write(75,*)'La somme des numacsy est',n,' differente de noac ('
     *   ,noac,')$'
         call scril
         print*,'*******************************************'
         stop
      endif
c
c on calcule ninacsy_fermi :
c Nombre d'orb par symetrie jusqu'au niveau de Fermi
c
      do i=1,nsym
         ninacsy_fermi(i)=0
      enddo
      do i=1,noc
         ninacsy_fermi(itsym(i))=ninacsy_fermi(itsym(i))+1
      enddo

c
c ninacsy a ete donne avant gel !
c on le corrige
c puis on recalcule noc  --> verif
c
      n=0
      do i=1,nsym
         ninacsy(i)=ninacsy(i)-frozen(i)
         n=n+ninacsy(i)
      enddo
      n=n+(nelac+1)/2
      if(n.ne.noc) then
         print*,' '
         print*,'*******************************************'
         print*,'mauvaise valeur dans ninacsy'
         write(75,*)'ninacsy=',(ninacsy(k),k=1,nsym),'$'
         call scril
         print*,'Sum(ninacsy)+(nelac+1)/2 .ne. noc '
         print*,'Sum(ninacsy)=',n-(nelac+1)/2
         print*,'  (nelac+1)/2',(nelac+1)/2
         print*,'          noc',noc
         print*,'*******************************************'
         stop
      endif

c
c On calcule :
c numacsy_occ/numacsy_vir : nb d'actives au-dessous et au-dessus
c du niveau de Fermi
c
      
      do i=1,nsym
         numacsy_occ(i)=ninacsy_fermi(i)-ninacsy(i)
         if(numacsy_occ(i)>0) print'(a,i2,a,i5)','sym',i,
     *   ' :      actives en-dessous du niveau de fermi',numacsy_occ(i)
      enddo
      do i=1,nsym
         numacsy_vir(i)=numacsy(i)-numacsy_occ(i)
         if(numacsy_vir(i)>0)print'(a,i2,a,i5)','sym',i,
     *   ' :      actives au-dessus du niveau de fermi ',numacsy_vir(i)
         if(numacsy_vir(i).lt.0) then
            print*,' '
            print*,'*******************************************'
            print*,'erreur dans la donnee de ninacsy'
            stop
         endif
      enddo

c
c On va chercher les numeros des actives :
c sous le niveau de Fermi
c Il y en a, par symetrie : numacsy_occ
c ce sont les dernieres de chaque symetrie
c au-dessus du niveau de Fermi
c Il y en a, par symetrie : numacsy_vir
c ce sont les premieres de chaque symetrie
c
      
      do i=1,nsym
         ninacsy_aj(i)=0
      enddo
c
c ninacsy_aj est un compteur des acitves ajoutees
c
c
c actives en-dessous du niveau de Fermi
c
      n=0
      do ii=noc,1,-1
         i=itsym(ii)
         if(numacsy_occ(i)-ninacsy_aj(i).gt.0) then
            ninacsy_aj(i)=ninacsy_aj(i)+1
            n=n+1
            numac(n)=ii
         endif
      enddo

c
c On recommence pour les actives en-dessus du niveau de Fermi
c

      do i=1,nsym
         ninacsy_aj(i)=0
      enddo
      do ii=noc+1,norb
         i=itsym(ii)
         if(numacsy_vir(i)- ninacsy_aj(i).gt.0) then
            ninacsy_aj(i)=ninacsy_aj(i)+1
            n=n+1
            numac(n)=ii
         endif
      enddo
      call reor(noac,numac)
      print*,' '
      write(75,*)' Numac =',(Numac(k),k=1,noac),'$'
      call scril
      print*,'----------------------------------------------'
      print*,' '
      return
      end
         


      
