      subroutine selec2
!
!======================================================================
! Generation des determinants du CAS, et de leur distance
! par rapport aux determinants de reference
!
! Signification de la distance
!
! Un det CAS de dist 0 est une reference
! Un det CAS de dist 1 est obtenu par une excitation sur une ref
! Un det CAS de dist 2 est obtenu par 2 excitations sur une ref
!
!======================================================================
!
      use module
      use mod_script
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      common/dimnsa/idimnsa
      character(20) namel
      integer,allocatable,dimension(:,:) :: nsa
      integer ref(16),i1(16),i2(16),icompl(16),nd(19,0:2),ref2(16)
      integer ref3(16),ref4(16),ref5(16)
      character(16) uciref
      logical(1) yc(32),yc1(32)
      character(16) :: ccb
      yw=.false.
!
! On va noter la distance dans l'entier qui code aussi l'occupation
! du determinant
! Si on a 16 actives, on n'a plus de place pour coder la distance
! on la code dans jbin, entier 1
!
      if(noac==16) then
         allocate(jbin(ndetc))
         jbin=3
      else
         allocate(jbin(1))
      endif
!
! Titres
!
      if(uci) then
         call titre('CALCUL UCI#ESPACE ACTIF SELECTIONNE#'
     *   //'Les vecteurs ne seront pas fonction propre de spin#'//
     *   '(s2eigen est mis a F)#',40)
         s2eigen =.false.
      else if(.not.S2EIGEN) then
         call titre('ESPACE ACTIF SELECTIONNE#s2eigen=F#'
     *   //'Les vecteurs ne seront pas fonction propre de spin#',40)
      else
         call titre('ESPACE ACTIF SELECTIONNE#',40)
      endif
      rewind 93
      call LECNAM('&SELEC',namel,93,ierr,0)
      if(ierr==1) then
         call titre('calcul selectionne sans donnee &selec#stop#',40)
         stop
      endif
!
! Lecture des det de reference (donnes par &selec).
! On les stocke dans file 45
!
      open(45,form='formatted',status='unknown',file='SELEC')
      do
         read(93,'(a)') namel
         call maj(namel,20)
         if(index(namel,'FIN').ne.0) exit
         if(index(namel,'END').ne.0) exit
         write(45,'(a)') namel
      enddo
      rewind 45
      print*,' '
      ndet_ref=0
! boucle sur les ref
      !print'(a,16i4)','actives    ',numac(1:noac)
      print*,' '
      print*,'References'
!
! Boucle generale sur les references,
! simples et doubles excitations, en restant dans le CAS
! generation des equivalents de spin, on note la distance
!
C      open(46,form='unformatted',status='unknown',file='DETTMP')
      if(s2eigen) then
         ! calcul standard : l'espace SEL est fct propre de spin
         call gencassel(nd,ndet_ref)
      else
         !l'espace SEL n'est pas fct propre de spin (pas d'equiv de spin
         !generes)
         call gencassel_uci(nd,ndet_ref)
      endif
      if(yw)print'(a,19i3)','nd(:,0)',nd(:,0)
      if(yw)print'(a,19i3)','nd(:,1)',nd(:,1)
      if(yw)print'(a,19i3)','nd(:,2)',nd(:,2)
      n2=0
      n0=0
      n1=0
      n=0
      if(w2)print*,'ecriture de tous les det CAS, leur distance'
      do k=1,ndetc
         jdist=icaldist(k,jbin,ibinc,noac)
         if(w2) then
            write(6,'(a,2i6,3x,a,30l1)',advance='NO')'k,jdist',k,jdist,
     *      ccb(ibinc(k),noac)
     *      ,(btest(ibinc(k),l-1),l=1,noac)
            write(6,'(a,30l1)')' | ',
     *      (btest(ibinc(k),l+16-1),l=1,noac)
         endif
         if(jdist==0) then
            i=0
            do l=0,noac-1
               if(btest(ibinc(k),l)) i=i+1
            enddo
            if(i==nocac0)n=n+1
         endif
         if(jdist==0) n0=n0+1
         if(jdist<3) n2=n2+1
         if(jdist<2) n1=n1+1
      enddo
      print*,'nombre de determinants CAS total                   ',ndetc
      print*,'nombre de determinants sans spin SEL en donnee     ',n
      print*,'nombre de determinants SEL non-excites             ',n0
      print*,'nombre de det actifs S (mono-excites) / Ref        ',n1
      if(gener/='SEL+S0')
     *print*,'nombre de det actifs S et D / ref                  ',n2
      print*,' '
      print*,'Remarque : les determinants peuvent avoir'
      print*,'un spin peut etre different de celui d''un de Ref'
      print*,' '
      print*,' '
!
! les det CAS sont stockes, avec leurs distances, dans ibinc
! (on a utilise l'adressage du CAS sans selection)
!
      if(yw)print*,'fin selec2'
      return
      end
       subroutine gencassel(nd,ndet_ref)
      use module
      use mod_script
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Extension de l'espace selectionne
!
! Un espace selectionne (des determinants actifs) a ete fourni en donnee.
! Ces determinants formant un espace d'ordre zero. D'autres determinants
! portes par les actives seulement vont apparaitre si on fait SEL +SD, 
! SEL +DDCI... Il faut generer ces autres determinants avant le calcul.
! Ils sont generes ici.
! Ces determinants CAS peuvent avoir -1, -2 electrons, etc... A chaque 
! determinant CAS correspond une "distance", qui correspond au nombre
! d'excitations pour le creer a partir du determinant de reference le plus 
! proche
! Ref : dist=0
! -1 el,+1 el, 1 deplacement : dist=1
! -2 el,+2 el, 2 deplacements : dist=2
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 

      implicit real(8) (a-h,o-x,z),logical(1)(y)
      common/dimnsa/idimnsa
      character(20) namel
      integer,allocatable,dimension(:,:) :: nsa
      integer ref(16),i1(16),i2(16),icompl(16),nd(19,0:2),ref2(16)
      integer ref3(16),ref4(16),ref5(16)
      logical(1) yc(32),yc1(32)
      yw=.false.
      allocate(nsa(noac,c(noac,noac/2)))
      nd=0
      idimnsa=c(noac,noac/2)
      do
         ! Lecture d'une ref
         read(45,'(16i1)',end=1001) ref(1:noac)
         if(yw)print*,'SELEC det lu  ',ref(1:noac)
         ndet_ref=ndet_ref+1
         if(ndet_ref<20) then
            print'(a,i6,1x,16i4)','ref ',ndet_ref,ref(1:noac)
         else if (ndet_ref==20) then
            print*,'       ...'
         endif
         if(sum(ref(1:noac)).ne.nelac) then
            print*,'erreur dans le fichier SELEC'
            print'(a,i6,a,16i1)','ligne',ndet_ref,'  ',ref(1:noac)
            print*,sum(ref(1:noac)),' electrons dans la ref, nelac='
     *      ,nelac
            stop
         endif
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! On va maintenant effectuer les differentes excitations possibles
! (ajouter, enlever, deplacer 1 ou 2 electrons)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! - On n'excite pas la ref
! appel ref_yc : generation des aquivalents de spin, noter la distance
! (0 ici, en donnee a ref_yc)...
!
         if(yw.or.w2)print*,'reference (dist=0)'
         call ref_yc(ref,nsa,nd,0)
         if(igener==0) cycle
         ! - 1 el
! - ...On enleve 1 el a la reference. La distance est donc 1...
         if(yw.or.w2)print*,' -1 el (dist=1)'
         do k=1,noac
            ref2=ref
            if(ref(k)>0) then
               ref2(k)=ref2(k)-1
               call ref_yc(ref2,nsa,nd,1)
            endif
         enddo
! ...etc...
         ! + 1 el
         if(yw.or.w2)print*,' +1 el'
         do k=1,noac
            ref2=ref
            if(ref(k)<2) then
               ref2(k)=ref2(k)+1
               call ref_yc(ref2,nsa,nd,1)
            endif
         enddo
         ! - 2 el
         if(gener(5:6)/='S0') then
            if(yw.or.w2)print*,' -2 el'
            do k=1,noac
               if(ref(k)>0) then
                  ref2=ref
                  ref2(k)=ref2(k)-1
                  do l=k,noac
                     if(ref2(l)>0) then
                        ref3=ref2
                        ref3(l)=ref3(l)-1
                        call ref_yc(ref3,nsa,nd,2)
                     endif
                  enddo
               endif
            enddo
            ! + 2 el
            if(yw.or.w2)print*,' +2 el'
            do k=1,noac
               if(ref(k)/=2) then
                  ref2=ref
                  ref2(k)=ref2(k)+1
                  do l=k,noac
                     if(ref2(l)/=2) then
                        ref3=ref2
                        ref3(l)=ref3(l)+1
                        call ref_yc(ref3,nsa,nd,2)
                     endif
                  enddo
               endif
            enddo
         endif
         ! deplacement
         if(yw.or.w2)print*,' deplacement'
         do k=1,noac
            if(ref(k)>0) then
               ref2=ref
               ref2(k)=ref2(k)-1
               do l=1,noac
                  if(k==l) cycle
                  if(ref2(l)/=2) then
                     ref3=ref2
                     ref3(l)=ref3(l)+1
                     call ref_yc(ref3,nsa,nd,1)
                  endif
               enddo
            endif
         enddo
         if(gener(5:6)/='S0') then
            ! 2 deplacements
            if(yw.or.w2)print*,' 2 deplacements',ref(1:noac)
            do k=1,noac
               if(ref(k)>0) then
                  ref2=ref
                  ref2(k)=ref2(k)-1
                  do l=1,noac
                     if(k==l) cycle
                     if(ref2(l)/=2) then
                        ref3=ref2
                        ref3(l)=ref3(l)+1
                        do m=k,noac
                           if(m==l) cycle
                           if(ref3(m)>0) then
                              ref4=ref3
                              ref4(m)=ref4(m)-1
                              do n=l,noac
                                 if(n==m) cycle
                                 if(n==k) cycle
                                 if(ref4(n)<2) then
                                    ref5=ref4
                                    ref5(n)=ref5(n)+1
                                    !print*,'appel ref_yc',ref5(1:noac)
                                    if(yw)print'(4i2)',k,l,m,n
                                    call ref_yc(ref5,nsa,nd,2)
                                 endif
                              enddo
                           endif
                        enddo
                     endif
                  enddo
               endif
            enddo
            ! 1 deplacement, -1 el
            if(yw.or.w2)print*,' 1 deplacement -1 el',ref(1:noac)
            do k=1,noac
               if(ref(k)>0) then
                  ref2=ref
                  ref2(k)=ref2(k)-1
                  do l=1,noac
                     if(k==l) cycle
                     if(ref2(l)/=2) then
                        ref3=ref2
                        ref3(l)=ref3(l)+1
                        do m=k,noac
                           if(m==l) cycle
                           if(ref3(m)>0) then
                              ref4=ref3
                              ref4(m)=ref4(m)-1
                              if(yw)print'(4i2)',k,l,m
                              call ref_yc(ref4,nsa,nd,2)
                           endif
                        enddo
                     endif
                  enddo
               endif
            enddo
            ! 1 deplacement, +1 el
            if(yw.or.w2)print*,' 1 deplacement +1 el',ref(1:noac)
            do k=1,noac
               if(ref(k)>0) then
                  ref2=ref
                  ref2(k)=ref2(k)-1
                  do l=1,noac
                     if(k==l) cycle
                     if(ref2(l)/=2) then
                        ref3=ref2
                        ref3(l)=ref3(l)+1
                        do n=l,noac
                           if(n==k) cycle
                           ref5=ref3
                           ref5(n)=ref5(n)+1
                           !if(yw)print*,'appel ref_yc',ref5(1:noac)
                           if(yw)print'(4i2)',k,l,n
                           call ref_yc(ref5,nsa,nd,2)
                        enddo
                     endif
                  enddo
               endif
            enddo
         endif
      enddo
      deallocate(nsa)
 1001 continue
      print *,' '
      if(ndet_ref>=20) print*,ndet_ref,' references'
      print *,' '
      return
      end
       subroutine gencassel_uci(nd,ndet_ref)
      use module
      use mod_script
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      common/dimnsa/idimnsa
      character(20) namel
      integer,allocatable,dimension(:,:) :: nsa
      integer ref(16),i1(16),i2(16),icompl(16),nd(19,0:2),ref2(16)
      integer ref3(16),ref4(16),ref5(16)
      logical(1) yc(32),yc1(32)
      character(16) uciref
      character :: op(2),spin(2)
      op=(/'+','-'/)
      spin=(/'+','-'/)
      yw=.false.
      allocate(nsa(noac,c(noac,noac/2)))
      nd=0
      idimnsa=c(noac,noac/2)
      do
! Lecture d'une ref
         uciref=' '
         read(45,'(a)',end=1001) uciref
         if(yw)print*,'SELEC det lu',uciref
         ndet_ref=ndet_ref+1
         print'(a,i6,1x,a)','ref ',ndet_ref,uciref
!   bon nombre d'actives ?
         if(len_trim(uciref).ne.noac) then
            print*,'erreur dans le fichier SELEC'
            print'(a,i6,a,16i1)','ligne',ndet_ref,'  ',uciref
            print*,len_trim(uciref),' orbitales actives, noac='
     *      ,noac
         endif
!   bon nombres d'alpha et de beta ?
         nbal=0
         nbbet=0
         do k=1,noac
            if(uciref(k:k)/='2'.and.uciref(k:k)/='0'.and.
     *      uciref(k:k)/='+'.and.uciref(k:k)/='-') then
               print*,'erreur dans le fichier SELEC'
               print'(a,i6,a,a)','ligne',ndet_ref,'  ',uciref
               print*,'donnees possibles : 2,0,+,-'
               stop
            endif
            if(uciref(k:k)=='2') nbal=nbal+1
            if(uciref(k:k)=='2') nbbet=nbbet+1
            if(uciref(k:k)=='+') nbal=nbal+1
            if(uciref(k:k)=='-') nbbet=nbbet+1
         enddo
         if(nbal/=nocac0) then
            print*,'erreur dans le fichier SELEC'
            print'(a,i6,a,a)','ligne',ndet_ref,'  ',uciref
            print*,nbal,' electrons alpha en donne',
     *      nocac0,' electrons alpha dans le systeme'
            stop
         endif
         if(nbbet/=nocbc0) then
            print*,'erreur dans le fichier SELEC'
            print'(a,i6,a,a)','ligne',ndet_ref,'  ',uciref
            print*,nbbet,' electrons beta en donne',
     *      nocbc0,' electrons beta dans le systeme'
            stop
         endif
! On traduit uciref en ref
         do k=1,noac
            if(uciref(k:k)=='0') ref(k)=0
            if(uciref(k:k)=='2') ref(k)=2
            if(uciref(k:k)=='+') ref(k)=1
            if(uciref(k:k)=='-') ref(k)=-1
         enddo
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! On va maintenant effectuer les differentes excitations possibles
! (ajouter, enlever, deplacer 1 ou 2 electrons)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! - On n'excite pas la ref
! appel ref_yc : generation des equivalents de spin, noter la distance
! (0 ici, en donnee a ref_yc)...
!
         if(yw)print*,'reference  (dist=0)'
         call ref_yc_uci(ref,nd,0)
         if(igener==0) cycle
         ! - 1 el
! ...On enleve ou on ajoute 1 el a la reference. La distance est donc 1
         do kop=1,2
            do kspin=1,2
               if(yw)print*, op(kop)//'1 el '//spin(kspin)
               !print*,'ref0',ref(1:noac)
               do k=1,noac
                  ref2=ref
                  call uci_exc(op(kop),spin(kspin),ref2(k),noac)
                  !print*,'ref2',ref2(1:noac)
                  if(ref2(k)==3) cycle
                  call ref_yc_uci(ref2,nd,1)
               enddo
            enddo
         enddo
! 1 deplacement        distance 1
         if(yw)print*,' deplacement dans les actives (dist=1)'
         do kspin=1,2
            if(yw)print*,' '
            if(yw)print*,' Deplacement 1 el '//spin(kspin)
            do k=1,noac
               ref3=ref
               call uci_exc('-',spin(kspin),ref3(k),noac)
               if(ref3(k)==3) cycle
               do l=1,noac
                  if(k==l) cycle
                  ref2=ref3
                  call uci_exc('+',spin(kspin),ref2(l),noac)
                  if(ref2(l)==3) cycle
                  call ref_yc_uci(ref2,nd,1)
               enddo
            enddo
         enddo
! ...On enleve 1 el et on ajoute 1 el a la reference. distance 1
         if(igener==1) cycle
         do kspin1=1,2
            do kspin2=1,2
               do k=1,noac
                  ref3=ref
                  call uci_exc('-',spin(kspin1),ref3(k),noac)
                  if(ref3(k)==3) cycle
                  do l=1,noac
                     if(kspin1==kspin2.and.k==l) cycle
                     ref2=ref3
                     call uci_exc('+',spin(kspin2),ref2(l),noac)
!                    print*,'COUCOU',ref(1:noac),ref2(1:noac)
                     if(ref2(l)==3) cycle
!                    print*,'OK'
                     call ref_yc_uci(ref2,nd,1)
                  enddo
               enddo
            enddo
         enddo
! ...On enleve ou on ajoute 2 el a la reference. La distance est donc 2
         do kop=1,2
            do kspin1=1,2
               do kspin2=kspin1,2
                  if(yw)print*,' '
                  if(yw)print*, op(kop)//'2 el (',
     *            spin(kspin1),spin(kspin2)// ')'
                  do k=1,noac
                     ref3=ref
                     call uci_exc(op(kop),spin(kspin1),ref3(k),noac)
                     !print*,'ref3',ref3(1:noac)
                     if(ref3(k)==3) cycle
                     ldeb=1
                     if(kspin1==kspin2) ldeb=k
                     do l=ldeb,noac
                        ref2=ref3
                        call uci_exc(op(kop),spin(kspin2),ref2(l),noac)
                        !print*,'ref2',ref2(1:noac)
                        if(ref2(l)==3) cycle
                        call ref_yc_uci(ref2,nd,2)
                     enddo
                  enddo
               enddo
            enddo
         enddo
! 2 deplacements        distance 2
         if(yw)print*,' 2 deplacements'
         do kspin1=1,2
            do kspin2=kspin1,2
               if(yw)print*,' Deplacement 2 el '//'('//spin(kspin1)//
     *         spin(kspin2)//')'
               do k1=1,noac
                  ref2=ref
                  call uci_exc('-',spin(kspin1),ref2(k1),noac)
                  if(ref2(k1)==3) cycle
                  k2deb=1
                  if(kspin1==kspin2) k2deb=k1
                  do k2=k2deb,noac
                     ref3=ref2
                     call uci_exc('-',spin(kspin2),ref3(k2),noac)
                     if(ref3(k2)==3) cycle
                     do l1=1,noac
                        if(l1==k1) cycle
                        if(l1==k2.and.kspin1==kspin2) cycle
                        ref4=ref3
                        call uci_exc('+',spin(kspin1),ref4(l1),noac)
                        if(ref4(l1)==3) cycle
                        l2deb=1
                        if(kspin1==kspin2) l2deb=l1
                        do l2=l2deb,noac
                           if(l2==k2) cycle
                           if(l2==k1.and.kspin1==kspin2) cycle
                           ref5=ref4
                           call uci_exc('+',spin(kspin2),ref5(l2),noac)
                           if(ref5(l2)==3) cycle
                           idist=2
                           if(uci) then
                              if(k1==l2.and.k2==l1) then
                                 if(yw)print*,'echange'
                                 !idist=3
                              endif
                           endif
                           call ref_yc_uci(ref5,nd,idist)
                        enddo
                     enddo
                  enddo
               enddo
            enddo
         enddo
! 1 deplacement, +/-1 el       distance 2
         do kop=1,2
            do kspin1=1,2
               do kspin2=1,2
                  if(yw)print*,' 1 deplacement ('//spin(kspin1)//
     *            ')   '//op(kop)//'1 el ('//spin(kspin2)//')'
                  do k1=1,noac
                     ref2=ref
                     !print*,'ref',ref(1:noac)
                     call uci_exc('-',spin(kspin1),ref2(k1),noac)
                     if(ref2(k1)==3) cycle
                     do k2=1,noac
                        if(k2==k1) cycle
                        ref3=ref2
                        call uci_exc('+',spin(kspin1),ref3(k2),noac)
                        if(ref3(k2)==3) cycle
                        do l=1,noac
                           if(kspin1==kspin2) then
                              if(kop==1) then
!                                on ajoute 1 el
                                 if(l<=k2) cycle
                                 if(l==k1) cycle
                              else
!                                on enleve 1 el
                                 if(l<=k1) cycle
                                 if(l==k2) cycle
                              endif
                           endif
                           ref4=ref3
                           call uci_exc(op(kop),spin(kspin2),
     *                     ref4(l),noac)
                           if(ref4(l)==3) cycle
                           call ref_yc_uci(ref4,nd,2)
                        enddo
                     enddo
                  enddo
               enddo
            enddo
         enddo
      enddo
      deallocate(nsa)
 1001 continue
      return
      end
      function cc(yc,noac)
      character(16) :: cc
      logical(1) :: yc(noac+noac)
      cc=' '
      do i=1,noac
         if(yc(i).and.yc(i+noac)) cc(i:i)='2'
         if(yc(i).and..not.yc(i+noac)) cc(i:i)='^'
         if(.not.yc(i).and.yc(i+noac)) cc(i:i)='v'
         if(.not.yc(i).and..not.yc(i+noac)) cc(i:i)='0'
      enddo
      end
      function ccb(ic,noac)
      character(16) :: ccb
      ccb=' '
!      print*,'CCB',(btest(ic,i-1),i=1,noac),' | ',
!     *(btest(ic,i-1),i=1+16,noac+16)
      do i=1,noac
         if(btest(ic,i-1).and.btest(ic,16+i-1)) ccb(i:i)='2'
         if(btest(ic,i-1).and..not.btest(ic,16+i-1)) ccb(i:i)='^'
         if(.not.btest(ic,i-1).and.btest(ic,16+i-1)) ccb(i:i)='v'
         if(.not.btest(ic,i-1).and..not.btest(ic,16+i-1)) ccb(i:i)='0'
      enddo
      end
       subroutine caldfc0
      use module
      use mod_script
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      parameter (maxorbcas2=16)
      character(maxorbcas2+48) bb
      yw=.false.
      if(yw)print*,'ndetc',ndetc
      index=0
      if(yw)print*,
     *'                      det cas,idist,icl,nalpha,nbeta,jj,index'
      nc=0
      do kc=1,ndetc
         bb=' '
         i=ibinc(kc)
         do k=1,noac
            if(i==ibset(i,k-1)) then
               if(i==ibset(i,k+16-1)) then
                  bb(8+k:8+k)='2'
               else
                  bb(8+k:8+k)='+'
               endif
            else
               if(i==ibset(i,k+16-1)) then
                  bb(8+k:8+k)='-'
               else
                  bb(8+k:8+k)='0'
               endif
            endif
         enddo
         if(yw)bb(8:8)='['
         if(yw)bb(noac+9:noac+9)=']'
         idist=icaldist(kc,jbin,ibinc,noac)
! classe du determinant kc
         nalpha=-nocac0
         nbeta=-nocbc0
         do k=1+8,noac+8
            if(bb(k:k)=='2') then
               nalpha=nalpha+1
               nbeta=nbeta+1
            endif
            if(bb(k:k)=='+') nalpha=nalpha+1
            if(bb(k:k)=='-') nbeta=nbeta+1
         enddo
         icl=iclasc(nalpha,nbeta)
! calcul de idetc, point de depart des determinants TCP qui ont
! le det CAS kc
         jj=0
         if(idist<3) jj=jdimc(icl,idist)
         idetc(kc)=index
         index=index+jj
         if(yw)then
            if(idist==3) then
               print'(a3,a20,6x,4i3,2i8)','bb ',
     *         bb,idist,icl,nalpha,nbeta,
     *         jj,index
            else
               nc=nc+1
               print'(a3,a20,i6,4i3,2i8)','bb ',
     *         bb,nc,idist,icl,nalpha,nbeta,
     *         jj,index
            endif
         endif
      enddo
      ndet=index
      return
      end
       subroutine ref_yc(ref,nsa,nd,jdist)
!
! Generation des equivalents de spin, stockage du det CAS et de la
! distance
!
! en entree : ref=det CAS
!             - nsa= espace de travail temporaire
!             - jdist=distance
! en sortie : - nd(icl,jdist)=nombre de det CAS de classe icl et de
!             distance jdist. Rappel : icl=classe d'un det CAS=fonction
!             de (nb d'alpha,nb de beta)(-2:2,-2,2). Il y a 19 classes
!             - jbin=codage distance, si 16 actives
!
      use module
      common/dimnsa/idimnsa
      integer ref(16),i1(16),i2(16),icompl(16),nd(19,0:2)
      !dimension nsa(noac,c(noac,nocac0))
      dimension nsa(noac,idimnsa)
      logical(1) yc(32),yw
      character(16) :: cc
!
! uci=F, calcul en symetrie de spin
!
      yw=.false.
      !
      ! Place des '1','2' tableau il
      ! nb1,nb2 = nb de 1 et de 2 dans la donnee de la ref
      !
      nb1=0
      nb2=0
      do k=1,noac
         if(ref(k)==1) then
            nb1=nb1+1
            i1(nb1)=k
         else if(ref(k)==2) then
            nb2=nb2+1
            i2(nb2)=k
         endif
      enddo
      if(yw) print*,'entree ref_yc'
      if(yw) print*,'ref',ref(1:noac)
      if(yw) print*,'place des 1',i1(1:nb1)
      if(yw) print*,'place des 2',i2(1:nb2)

      ! test de compatibilite
      if(abs(ms2)>nb1) then
         if(jdist==0) then
            print*,'pas de place pour les electrons celibataires avec',
     *      ' ms2=',ms2
            stop
!         else
!            return
         endif
      endif


      ! Generation des equivalents de spin
      do ncela=0,nb1
         !
         ! ncela,ncelb = nb d'el celibataires en alpha et beta
         !
         if(ncela+nb2>nocac0+2) exit
         if(ncela+nb2<nocac0-2) cycle
         !print*,'ncela',ncela
         ncelb=nb1-ncela
         if(yw)print*,'ncela,ncelb,nb1',ncela,ncelb,nb1
         if(ncelb<0.or.ncelb>nb1) cycle
         if(ncelb+nb2<nocbc0-2) cycle
         if(ncelb+nb2>nocbc0+2) cycle
         !call combin(nsa,nb1,ncela,nta,noac,c(noac,nocac0))
         call combin(nsa,nb1,ncela,nta,noac,c(noac,noac/2))

         ! Generation des determinants
         nal=ncela+nb2-nocac0
         nbet=ncelb+nb2-nocbc0
         if(gener(5:8)==' ') then
            if(nal/=0) cycle
            if(nbet/=0) cycle
         endif
         if(gener(5:8)=='S   '.or.gener(5:8)=='S0  ') then
            if(abs(nal)>1) cycle
            if(abs(nbet)>1) cycle
         endif
         !print*,'nal,nbet',nal,nbet,nta
         if(abs(nal+nbet)>2) cycle
         do ka=1,nta
            ! le det est ecrit en logiques
            yc=.false.
            yc(i2(1:nb2))=.true.
            yc(i2(1:nb2)+noac)=.true.
            yc(i1(nsa(1:ncela,ka)))=.true.
            call comple(nb1,i1,ncela,i1(nsa(1:ncela,ka)),ncelb,icompl)
            !print*,'nsa',nsa(1:ncela,ka)
            !print*,'nsb',icompl(1:ncela)
            yc(icompl(1:ncelb)+noac)=.true.
            ! Adresse
!
! On calcule l'adresse du determinant dans la liste totale des
! determinants CAS
! Ce determinant a peut-etre ete deja genere par d'autres references
! si c'est le cas, la distance retenue sera la plus courte
! (fait dans encodbin)
!
            call adrc(yc,iadrc,irang)
            !if(w2)print*,'yc',yc(1:noac),'   ',yc(noac+1:noac+noac)
     *      !,irang,'   dist',jdist
            if(w2)print*,'cc   ',cc(yc,noac),irang,'   dist',jdist
            ! encodbin : encodage en binaire de la distance
            call encodbin(nd,jdist,irang,noac,ibinc(irang),jbin,
     *      iclasc(nal,nbet))
         enddo
      enddo
      return
      end
       subroutine ref_yc_uci(ref,nd,jdist)
!
! Stockage du det CAS et de la distance
!
! en entree : ref=det CAS
!             - nsa= espace de travail temporaire
!             - jdist=distance
! en sortie : - nd(icl,jdist)=nombre de det CAS de classe icl et de
!             distance jdist. Rappel : icl=classe d'un det CAS=fonction
!             de (nb d'alpha,nb de beta)(-2:2,-2,2). Il y a 19 classes
!             - jbin=codage distance, si 16 actives
!
      use module
      common/dimnsa/idimnsa
      integer ref(16),i1(16),i2(16),i_1(16),icompl(16),nd(19,0:2)
      dimension nsa(noac,idimnsa)
      logical(1) yc(32),yw
      yw=.false.
      !
      ! Place des '1','2'
      ! nb1,nb2 = nb de 1 et de 2 dans la donnee de la ref
      !
      nal=-nocac0
      nbet=-nocbc0
      do k=1,noac
         if(ref(k)==1) then
            nal=nal+1
         else if(ref(k)==-1) then
            nbet=nbet+1
         else if(ref(k)==2) then
            nal=nal+1
            nbet=nbet+1
         endif
      enddo
!
! On calcule l'adresse du determinant dans la liste totale des
! determinants CAS
! Ce determinant a peut-etre ete deja genere par d'autres references
! si c'est le cas, la distance retenue sera la plus courte
! (fait dans encodbin)
!
 
 
 
      ! le det est ecrit en logiques
      yc=.false.
      !print*,'REF',ref(1:noac)
      do k=1,noac
         yc(k)=ref(k)>0
         yc(k+noac)=ref(k)==2.or.ref(k)==-1
      enddo
      call adrc(yc,iadrc,irang)
      if(yw.or.w2)
     *print*,'yc',yc(1:noac),'   ',yc(noac+1:noac+noac)
     *,irang,'   dist',jdist
      ! encodbin : encodage en binaire de la distance
      call encodbin(nd,jdist,irang,noac,ibinc(irang),jbin,
     *iclasc(nal,nbet))
      return
      end
       subroutine lim_sel(nt,np,jdist,ibon)
      use module
      ibon=0
      if(jdist==3) return
      if(gener/='SEL+S0') then
         if(nt==np) then
            if(np>2-jdist) return
            if(nt>2-jdist) return
         else if (nt-np==1) then
            if(jdist==0) return
            if(nt==2.and.jdist==2) return
         else if (np-nt==1) then
            if(jdist==0) return
            if(np==2.and.jdist==2) return
         else
            if(jdist/=2) return
         endif
      elseif(gener=='SEL+S0') then
         if(nt==np) then
            if(np>1-jdist) return
            if(nt>1-jdist) return
         else if (nt-np==1) then
            if(jdist==0) return
            if(nt==1.and.jdist==1) return
         else if (np-nt==1) then
            if(jdist==0) return
            if(np==1.and.jdist==1) return
         endif
      endif
      ibon=1
      return
      end
       function icaldist(i,jbin,jbinc,noac)
      integer(1) jbin(*)
      dimension jbinc(*)
      logical y1,y2,yw
      yw=.false.
      if(noac>14) then
!        jamais teste !
         icaldist=jbin(i)
      else
         if(yw)write(6,*)'i',i
         if(yw)write(6,*)btest(jbinc(i),1-1)
         if(yw)write(6,'(a,16l1,2x,16l1)')'icaldist ',
     *   (btest(jbinc(i),k-1),k=1,32)
         ll=noac+1
         kk=16+noac+1
         y1=btest(jbinc(i),ll-1)
         y2=btest(jbinc(i),kk-1)       ! ifc refuse y2=btest(ibin,32)  ???
         if(.not.y1.and..not.y2) icaldist=3
         if(.not.y1.and.y2) icaldist=1
         if(y1.and..not.y2) icaldist=2
         if(y1.and.y2) icaldist=0
         if(yw)write(6,*)'fin icaldist',icaldist
      endif
      return
      end
       subroutine uci_exc(operation,spin,ref2,noac)
      character operation,spin
      integer ref2
!
!-------------------------------------------------
! operations sur ref2
! en entree, ref2==-1,0,1 ou 2 (beta, pas d'el,alpha, 2 el)
! operation='+' ou '-', (ajout ou soustraction d'el)
! spin='+' ou '-'
!
! en sortie, nouveau ref == -1,0,1 ou 2 (apres operation)
! ref==3 si operation impossible
!-------------------------------------------------
!
      if(operation=='-') then
         if(spin=='-') then
            if(ref2==2) then
               ref2=1
            else if(ref2==-1) then
               ref2=0
            else
               ref2=3
               return
            endif
         else if(spin=='+') then
            if(ref2==2) then
               ref2=-1
            else if(ref2==1) then
               ref2=0
            else
               ref2=3
               return
            endif
         endif
      else if(operation=='+') then
         if(spin=='-') then
            if(ref2==0) then
               ref2=-1
            else if(ref2==1) then
               ref2=2
            else
               ref2=3
               return
            endif
         else if(spin=='+') then
            if(ref2==0) then
               ref2=1
            else if(ref2==-1) then
               ref2=2
            else
               ref2=3
               return
            endif
         endif
      endif
      return
      end
