      subroutine jacobi
      use module
      use mod_ena
      use mod_script
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer,allocatable,dimension(:) :: icas,icas2,icas3,icas4
      double precision,allocatable,dimension(:,:) :: h,v
      double precision,allocatable,dimension(:) :: v0
      allocatable y(:)
      yw=.false.
!
! calcul de la dim de H des det CAS
!
      longc=ifinc(1)-idebc(1)+1
      if(gener(1:3)=='SEL') then
         ! Alors, il peut y avoir des det CAS de dist trop grande entre
         ! idebc(1) et ifinc(1). On ne garde que les "bons"
         longc2=0
         allocate(icas3(longc),icas4(longc),y(longc))
         y=.true.
         do k=idebc(1),ifinc(1)
            if(icaldist(k,ibin,ibinc,noac)==0) then
               longc2=longc2+1
               icas3(k)=longc2
               y(k)=.false.
             !print*,'k,icas3',k,icas3(k)
               icas4(longc2)=k
            endif
         enddo
         print*,'longc,longc2',longc,longc2
      else
         longc2=longc
      endif
!
! Allocations
!
      allocate(icas(ndet+1))
      allocate(icas2(longc))
      icas=0
      icas(idetc(1:longc)+1)=(/(k,k=1,longc)/)
      do k=1,longc
         icas2(k)=idetc(k)+1
      enddo
      allocate(h(longc2,longc2))
      allocate(v(longc2,longc2))
      allocate(v0(ndet))
      !print*,'longc2',longc2
!
! Construction de H
!
      h=0.d0
      v=0.d0
      v0=0.d0
      rewind 50
      do
         read(50) imat,jmat,dmat
         ifin=2048
         if(imat(ifin)<0) ifin=jmat(ifin)
         do k=1,ifin
            i=icas(imat(k))
            if(i==0) cycle
            j=icas(jmat(k))
            if(j==0) cycle
            if(gener(1:3)=='SEL') then
               if(y(i)) cycle
               if(y(j)) cycle
               i=icas3(i)
               j=icas3(j)
            endif
            if(i==j) then
               h(i,i)=dmat(k)*2+h(i,i)
            else
               h(i,j)=dmat(k)+h(i,j)
               h(j,i)=dmat(k)+h(j,i)
            endif
         enddo
         if(imat(2048)<0) exit
      enddo
      if(mprint(6)==1) print*,'nessai==3, mat CAS dans jacobi'
      if(mprint(6)==1) call mscript(h)
!
! Diagonalisation
!
      call hdiag(h,v,longc2,longc2)
! Cas de l'habillage : on sauve les vecteurs propres du CAS
      if(mhab/=0) then
         open(99,file='VEC_PRO_CAS',form='unformatted',
     *   status='unknown')
         write(99) longc2,v(:,longc2:1:-1)
         close(99)
      endif
      !print*,'habillage',v(:,longc2-kk+1),nhab,k,nhab
      if(yw) call mscript(v)
!
! Mise des vecteurs du CAS (dimension longc2) dans les vecteurs d'essai
! (dimension ndet)
!
      k=1
      kk=0
      v0=0.d0
      do 
         kk=kk+1
         if(kk>longc2) then
            call titre(
     *      'La diagonalisation du CAS ne peut pas donner#'//
     *      ' assez de vecteurs d''essai#',50)
            stop
         endif
         do l=1,longc2
            if(gener(1:3)=='SEL') then
               ll=icas4(l)
            else
               ll=l
            endif
            aa=v(l,longc2-kk+1)
            ll=icas2(ll)
            v0(ll)=aa
            if(yw)print*,'kk',kk,icas2(l),k,aa
         enddo
         print'(i6)',k
c! symetrisation en spin de v0
c!         call syspin2(v0)
! symetrisation de v0
         call symdet3(v0)
! norme
         anorm=dot_product(v0,v0)
         if(yw)print*,'anorm',anorm
         if(anorm<1.d-5) cycle
         v0=v0/dsqrt(anorm)
! Ecriture sur DAF 21 et sur la sortie
         if(nessai==3) then
            call ecr(v0,k,ndet,21)
            print'(a,F20.10,/)',
     *      'E        ',h(longc2-kk+1,longc2-kk+1)+enuc+eref
             !print*,'eref',h(longc2-kk+1,longc2-kk+1),enuc,eref;stop
            do l=1,longc2
               if(gener(1:3)=='SEL') then
                  ll=icas4(l)
               else
                  ll=l
               endif
               !print*,'l,ll,v',l,ll,v(l,longc2-kk+1)!,v(ll,longc2-kk+1)
               aa=v(l,longc2-kk+1)
               if(abs(aa)>=twvec) then
                  call ecrivec2(aa,ll)
               endif
            enddo
         endif
         k=k+1
         if(k>nvec) exit
         v0=0.d0
      enddo
      deallocate(v0,icas,icas2,h,v)
      return
      end
