      subroutine condoc
      use module
      implicit none
      integer :: orb_occ(16),nel1(2),lim(0:16),orb_occ1(16),nel(2,16)
      integer occup(16)
      character(10000) :: namel
      integer :: i,ifil_cond_occ,ierr,j,k,ifil1,ifil2,n,ideb,ifin,m,l
      integer :: nfrag,nref,nrefsansspin
      integer,parameter :: long=100
      logical ybon,yw
      yw=.false.
      if(yw)print*,'condoc cond_occ',cond_occ
      if(.not.cond_occ) return
      print*,' '
      print*,' '
      call titre('ESPACE ACTIF CAS AVEC CONDITIONS#'//
     *'On part d''un CAS, on retire des determinants'//
     *' en fonction des conditions#'//
     *'puis on considere qu''on a un espace selectionne#',60)

      ! il y a des conditions sur les occupations des orbitale.
      ! ouvrir le fichier de determinants selectionnes qu'on va creer
      call open_chose_number(ifil_cond_occ,'COND_OCC',
     *'unknown','formatted')
      call open_chose_number(ifil1,'COND_OCC1','unknown','unformatted')
      call open_chose_number(ifil2,'COND_OCC2','unknown','unformatted')

      if(yw) then
         print*,'ndetc',ndetc
         print*,'ifinc',ifinc(1)
         do i=1,ifinc(1)
            print*,'ibinc',i,(btest(ibinc(i),k),k=0,noac-1),' | ',
     *      (btest(ibinc(i),k+16),k=0,noac-1)
         enddo
      endif
      


      ! lecture des conditions
      rewind 93
      lim(0)=0
      nfrag=0
      ifin=0
      print*,'CONDITIONS:'
      print*,"FRAGMENT       NB D'EL DS FRAG        ORB DU FRAGMENT"
      print*,"              (entre les bornes)            "
      do
         nel1=-1
         if(yw) then
            call LECNAM('&COND',namel,93,ierr,1)
         else
            call LECNAM('&COND',namel,93,ierr,0)
         endif
         orb_occ1=0
         call nameli(namel,orb_occ1,'ORB',4)
         call nameli(namel,NEL1,'NEL',4)
         if(nel1(1)>0.and.nel1(2)==-1) nel1(2)=nel1(1)
         do j=1,noac
            if(orb_occ1(j)==0) then
               n=j-1
               exit
            endif
         enddo
         ! n est le nb de valeurs non nulles de orb_occ1
         if(nel1(1)==-1) exit
         nfrag=nfrag+1
         nel(:,nfrag)=nel1(:)
         lim(nfrag)=n+lim(nfrag-1)
         ideb=ifin+1
         ifin=ifin+n
         orb_occ(ideb:ifin)=orb_occ1(1:n)
         print'(i6,12x,i3,a,i3,8x,20i4)',
     *   nfrag,nel1(1),' -->',nel1(2),orb_occ1(1:n)
      enddo
      if(yw) then
         print*,'lim',lim(1:nfrag)
         print*,'orb_occ',orb_occ
         print*,'nel(1)',nel(1,1:nfrag)
         print*,'nel(2)',nel(2,1:nfrag)
      endif



      ! on commence a rallonger le fichier de donnees
      do 
         read(93,*,end=2)
      enddo
 2    continue
      write(93,'(a)')' &selec   /'



      ! on parcourt les determinants et on ne retient que ceux
      ! qui satisfont les conditions
      l=0
      nref=0
      !print*,'lim',lim(0:nfrag)
      nrefsansspin=0
      do i=1,ifinc(1)
         occup=0
         call alpha_puis_beta(ibinc(i),noac,ybon)
         if(.not.ybon) cycle
         nrefsansspin=nrefsansspin+1
         !print*,(btest(ibinc(i),k-1),k=1,noac)
         !print*,(btest(ibinc(i),k-1+16),k=1,noac)
         do k=1,nfrag
            n=0
      !      print*,'LIM',lim(k-1)+1,lim(k)
            do j=lim(k-1)+1,lim(k)
               m=0
               if(btest(ibinc(i),j-1)) m=m+1
               if(btest(ibinc(i),j-1+16)) m=m+1
               if(btest(ibinc(i),orb_occ(j)-1)) n=n+1
               if(btest(ibinc(i),orb_occ(j)-1+16)) n=n+1
               occup(j)=m
      !         print*,'j,orb_occ(j),m,n',j,orb_occ(j),m,n
            enddo
      !      print*,'n',n,nel(1,k),nel(2,k)
            if(n<nel(1,k).or.n>nel(2,k)) goto 1
         enddo
!         print*,'IBINC',i,(btest(ibinc(i),k),k=0,noac-1),' | ',
!     *   (btest(ibinc(i),k+16),k=0,noac-1)
         l=l+1
      !   print'(i7,3x,16i1)',l,occup(1:noac)
         write(93,'(16i1)') occup(1:noac)
         nref=nref+1
 1       continue
      enddo
      write(93,'(a)')'fin'
      sel=2
      print*,nrefsansspin,' determinants CAS sans spin,',nref,
     *' references gardees'


      end
      subroutine alpha_puis_beta(ibinc,noac,ybon)
      implicit none
      integer ibinc,noac,i,spin,spinv,k
      logical ybon
      
      ! on lit des determinants avec spin, mais on genere seulement
      ! les det sans spin
      ! --> on ne retient dans les det lus que ceux ou tous les 
      ! alpha precedent les beta

      spinv=1
      spin=1
      ybon=.true.
!      print*,'AB',(btest(ibinc,k),k=0,noac-1),' | ',
!     *(btest(ibinc,k+16),k=0,noac-1)
      do i=0,noac-1
         if(btest(ibinc,i).and..not.btest(ibinc,i+16)) then
            spin=1
         else if(.not.btest(ibinc,i).and.btest(ibinc,i+16)) then
            spin=-1
         else
            cycle
         endif
         !print*,'i,spinv,spin',i,spinv,spin
         if(spinv==-1.and.spin==1) then
            ybon=.false.
            return
         endif
         spinv=spin
      enddo
      end
            
