      subroutine gencas
      use module
      use mod_script
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      integer,allocatable,dimension(:,:),save :: nsa,nsb
      allocatable y(:)
      ! Generation et adressage de la partie active du determinant
      !
      ! Un string est forme de nocac el + et ncobc el -
      ! nocac0 et ncobc0 sont les valeurs de nocac et ncobc pour un
      ! determinant sans trou ni part
      !on a : nocac0-2 <= nocac <= nocac0+2  id pour ncobc
      !
      ! On repartit les strings en classes, en fonction de nocac et
      ! nocbc. Cela fait 19 classes.
      ! l    : nombre de determinants CAS de la classe
      !
      !
      if(w2)print*,
     *'Generation et adressage de la partie active du determinant'
      if(w2)print*,
     *'(seules sont ecrites les classes non vides)'
      yw=.false.
      yw0=.true.
      iclasc=0
      exist_clasc=.false.
      l=1
      if(w2)print'(a)','          nca  ncb  classe long. idebc ifinc'
      call classc(0,0,1,l)
      nclasc=1
      ndetc=0
      if(igener>0) then
         call classc(-1,0,2,l)
         call classc(1,0,3,l)
         call classc(0,-1,4,l)
         call classc(0,1,5,l)
         call classc(-1,-1,6,l)
         call classc(1,1,7,l)
         call classc(-1,1,8,l)
         call classc(1,-1,9,l)
         nclasc=9
         if(igener>1) then
            call classc(-2,0,10,l)
            call classc(2,0,11,l)
            call classc(0,-2,12,l)
            call classc(0,2,13,l)
            call classc(-2,1,14,l)
            call classc(2,-1,15,l)
            call classc(1,-2,16,l)
            call classc(-1,2,17,l)
            call classc(-2,2,18,l)
            call classc(2,-2,19,l)
            nclasc=19
         endif
      endif
      if(w2)print*,'iclasc(-2:2,-2:2)'
      if(w2)call mscript(iclasc(-2:2,-2:2))
      !
      ! preparation de l'adressage du CAS
      !
      do nal=max(1,nocac0-2),min(nocbc0+2,noac)
         call caliz(noac,nal)
      enddo
      !ndetc=ifinc(nclasc)
      ndetc=l-1
      allocate(ibinc(ndetc))
      allocate(idetc(0:ndetc+1))
      idetc(0)=0
      !m=0
      !
      ! nombre total de determinants pour chaque classe du CAS
      !
      call comptc0
      !
      !pour verif de l'adressage
      !
      allocate(y(ndetc))
      if(yw)print*,'ndetc',ndetc
      y=.false.
      !
      ! Generation des strings du CAS : double boucle sur nalpha et
      ! nbeta. Stockage sous forme binaire dans ibinc
      !
      if(w2)print*,'Generation des strings du CAS'
      ideb=-2
      ifin=2
      if(igener==0) then
         ideb=0
         ifin=0
      else if (igener==1) then
         ideb=-1
         ifin=1
      endif
      do nalpha=ideb,ifin
         nocac=nocac0+nalpha
         if(nocac>noac.or.nocac<0) cycle
         allocate(nsa(max(1,nocac),c(noac,nocac)))
         call combin(nsa,noac,nocac,nta,nocac,c(noac,nocac))
         do k=1,nta
            call rang2(nocac,nsa(:,k),iranga)
            !print'(''iranga'',i8,3x,16i3)',iranga,nsa(:,k)
            do nbeta=ideb,ifin
               if(iclasc(nalpha,nbeta)==0) cycle
               n=nalpha+nbeta
               if(n>2.or.n<-2) cycle
               nocbc=nocbc0+nbeta
               if(nocbc>noac.or.nocbc<0) cycle
               allocate(nsb(max(1,nocbc),c(noac,nocbc)))
               call combin(nsb,noac,nocbc,ntb,nocbc,c(noac,nocbc))
               do l=1,ntb
                  call rang2(nocbc,nsb(:,l),irangb)
                  if(yw)print'(''irangb'',i8,3x,16i3)',irangb,nsb(:,l)
                  irang=irangb+(iranga-1)*ntb
!                 if(yw)
!     *           print*,'IRANG',irang,irang+idebc(iclasc(nalpha,nbeta))
                  irang=irang+idebc(iclasc(nalpha,nbeta))-1
!                 if(yw0)print'(a,i8,50i4)','IRANG',irang,nsa(:,k),
!     *           100000,nsb(:,l)
                  if(y(irang)) then
                     print*,'deja adresse',irang
                     stop
                  endif
                  y(irang)=.true.
                  call faibin(nsa(:,k),nsb(:,l),noac,nocac,nocbc,
     *            ibinc(irang))
C                  call lim_mr(nsa(:,k),nsb(:,l),noac,nocac,nocbc,limc)
!                 idetc est calcule dans comptc
                  call comptc(nalpha,nbeta,limc,irang)
               enddo
               deallocate(nsb)
            enddo
         enddo
         deallocate(nsa)
      enddo
      if(yw)print*,'y'
      if(yw)print'(50l1)',y
! Verif adressage
      if(any(.not.y)) then
         print*,'erreur adressage'
         print*,'y'
         print'(50l1)',y
         stop
      endif
      deallocate(y)
      do k=1,ndetc
         idetc(k)=idetc(k)+idetc(k-1)
      enddo
      ndet=idetc(ndetc)
      !idetc(1:ndetc+1)=idetc(0:ndetc)
      do k=ndetc,0,-1
         idetc(k+1)=idetc(k)
      enddo

      if(w2)print*,'gencas ndetc,ndet',ndetc,ndet
      !
      ! Allocation mdetc1,mdetc2,msgnc
      !
      mm=0
      do k=1,19
         if(exist_clasc(k)) mm=max(mm,ifinc(k)-idebc(k)+1)
      enddo
      allocate(mdetc1(mm))
      allocate(mdetc2(mm))
      allocate(msgnc(mm))
      return
      end
       subroutine classc(i,j,k,l)
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Indices de classc
! i,j, : nombre de spins alpha et beta
! k    : numero de la classe
! l    : nombre de determinants CAS de la classe
!
! fabrication des tableaux idebc et ifinc :
! Les det CAS sont ordonnes par classe CAS successives
! idebc(k=n° de la classe CAS) = debut de la liste des det CAS
! de la classe k
!§ iclasc(nca,ncb)=classe CAS
!§ iclasc1(1:2,n° de classe CAS)=(/nca,ncb/)

      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      use module
      idebc(k)=l
      if(nocac0+i>noac) return
      if(nocbc0+j>noac) return
      if(nocac0+i<0) return
      if(nocbc0+j<0) return
      iclasc1(:,k)=(/i,j/)
      iclasc(i,j)=k
      exist_clasc(k)=.true.
      !print*,noac,nocac0,nocac0+i,nocbc0+j
      l=l+c(noac,nocac0+i)*c(noac,nocbc0+j)
      ifinc(k)=l-1
      if(w2) then
         print'(''classc'',6i6)',i,j,k,l-1,idebc(k),ifinc(k)
      endif
      return
      end
C       subroutine lim_mr(nsa,nsb,noac,nocac,nocbc,limc)
C      !
C      ! Limitations du nombre de trous et part dans la cas MR
C      !
C      integer nsa(nocac),nsb(nocbc)
C      character(10000) namel
C      lim=0
C      !call LECNAM('&SELLOC',namel,45,ierr,0)
C      return
C      end
