      subroutine diaghab
      use module
!     use mod_ena
!     use mod_gen
!     use mod_script
      implicit real(8) (a-h,o-x,z),logical(1)(y)
      double precision, save, dimension(8) :: delta_prec=0.d0
      double precision, dimension(8) :: delta2
      double precision,allocatable,dimension(:,:) :: VEC_PRO_CAS
      common /habillage/ M,m2
      dimension vhab2(2048)
      yw=.false.
      yw1=.false.
      
      
      !if(iter>=10.and.iter<11) return
      
      
      
!
!------------------------------------
!     lecture de la diagonale de H
!------------------------------------
!
      rewind(20)
      call lir8bl(v1(:,1),ndet,20)
!
!-------------------------------------------
! Lecture du vecteur propre du CAS
!-------------------------------------------
!
      iadr=0
      if(noac==0) then
         allocate(VEC_PRO_CAS(1,1))
         VEC_PRO_CAS(1,1)=1.d0
         longc2=1
      else
         open(99,file='VEC_PRO_CAS',form='unformatted',status='old')
         read(99) longc2
         allocate(VEC_PRO_CAS(longc2,longc2))
         rewind 99
         read(99) longc2,VEC_PRO_CAS
         close(99)
      endif
      if(yw)call script(VEC_PRO_CAS,longc2,longc2,longc2,longc2)
!
!---------------------------------------------------------------
! Vecteur propre du CAS de recouvrement max avec le vecteur ref
! calcul de C0 : (=dot_product(Psi,Psi_CAS)
!---------------------------------------------------------------
!
      ibon=0
      cbon=0.d0
      do ivec=1,longc2
         k=0
         C0=0.d0
         do kc=idebc(1),ifinc(1)
            k=k+1
            iadr=idetc(kc)+1
            C0=C0+VEC_PRO_CAS(k,ivec)*vhab(iadr)
c              print'(a,2i5,a,i6,a,3f12.8)',
c    *         'k,ivec=',k,ivec,'  iadr=',iadr,' vhab=',
c    *         vhab(iadr),VEC_PRO_CAS(k,ivec),c0
            if(yw) then
               if(dabs(vhab(iadr)).gt.1.d-2) print*,
     *         'iadr=',iadr,' vhab=',
     *         vhab(iadr),VEC_PRO_CAS(k,ivec)
            endif
         enddo
         c0=dabs(c0)
         if(c0>cbon) then
            ibon=ivec
            cbon=c0
         endif
c        print*,'....'
      enddo
      c0=cbon
c     print*,'ibon',ibon
      print'(a,f8.4)','C0 = ',C0
      deallocate(VEC_PRO_CAS)
      
!
!-----------------------------------------------------------
! Calcul des accumulateurs delta
!-----------------------------------------------------------
!
      ! Renormalisation des increments d'habillage
      if(yw1)print'(a)','DELTA ='
      if(yw1)print'(3f16.12)',delta
      if(yw1)print'(a,f16.12)','sdelta=',sum(delta)
      delta=delta/C0
c      print*,'DELTA6',delta,c0
      if(yw1)print'(a)','DELTA ='
      if(yw1)print'(3f16.12)',delta
      if(yw1)print'(a,f16.12)','sdelta=',sum(delta)
      delta2=delta-delta_prec
      delta_prec=delta
      delta=delta2
      if(yw1)print'(a)','DELTA ='
      if(yw1)print'(3f16.12)',delta
      if(yw1)print'(a,f16.12)','sdelta=',sum(delta)
      
!
!----------------------------------------------------------------
! Habillage de la diagonale
! Meth :
! Generer les determinants dans l'ordre des adresses
! pour chaque det, corriger la diagonale
!----------------------------------------------------------------
!
      
      if(gener(1:3)=='SEL') then
         mindist=0
      else
         mindist=2
      endif
      ifin=0
      !
      ! Boucle sur les classes de determinants du CAS
      !
      do iclc=1,nclasc
         if(.not.exist_clasc(iclc)) cycle
         !
         ! boucle sur les distances (si selection)
         !
         do idist=mindist,2
            if(gener(1:3)=='SEL') then
               idebc(iclc)=jdebc(iclc,idist)
               ifinc(iclc)=jfinc(iclc,idist)
            endif
            !
            ! Boucle sur les det du CAS de la classe
            !
            if(yw)print*,'iclc,idebc(iclc),ifinc(iclc)'
     *      ,iclc,idebc(iclc),ifinc(iclc)
            do kc=idebc(iclc),ifinc(iclc)
               !
               ! Boucle sur les classes TP correspondant au CAS
               !
               do jcltp=1,nc_tp(iclc)
                  i=ic_tp(jcltp,iclc)
                  nta=icltp1(1,i)
                  ntb=icltp1(2,i)
                  npa=icltp1(3,i)
                  npb=icltp1(4,i)
                  !
                  ! Examen des differents cas
                  !
                  nt=nta+ntb
                  np=npa+npb
!                 print*,'nta,ntb,npa,npb',nta,ntb,npa,npb
!                 print*,'nt,np',nt,np
                  idim=idimtp(i)
!                 print*,'idim',idim
                  ideb=ifin+1
                  ifin=ifin+idim
      
                  if(gener(1:3)=='SEL') then
                     call lim_sel(nt,np,idist,ibon)
                     if(ibon==0) cycle
                  endif
! hab=1 2t 2p
! hab=2 2t 1p
! hab=3 2t 0p
! hab=4 1t 2p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p
                  if(igener==4) then
                     call diaghab4(nt,np,mhab,delta,ninac,noac,
     *               nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
                  else if (igener==3) then
                     call diaghab3(nt,np,mhab,delta,ninac,noac,
     *               nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
                  else if (igener==2) then
                     call diaghab2(nt,np,mhab,delta,ninac,noac,
     *               nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
                  else if (igener==1) then
                     call diaghab1(nt,np,mhab,delta,ninac,noac,
     *               nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
                  endif
               enddo
            enddo
         enddo
      enddo
!
!------------------------------------
! On recupere la diagonale precedente
!------------------------------------
!
      rewind 20
      call lir8bl(v2(:,1),ndet,20)
!     print*,'diaghab diagonale prec=',v2(:,1)
!
!------------------------------------
! On ecrit la nouvelle diagonale
!------------------------------------
!
      rewind 20
      call ecr8bl(v1(:,1),ndet,20)
!     print*,'diaghab diagonale nouv=',v1(:,1)
      if(yw.or.mprinth(3)==1) then
         do k=1,ndet
            print'(a,i3,3f12.8)','diaghab diff 2 diagonales=',
     *      k,v2(k,1),v1(k,1),v1(k,1)-v2(k,1)
         enddo
      endif
!
!--------------------------------------------------------------------
! Modification de l'hamiltonien effectif des iterations precedentes
!--------------------------------------------------------------------
!
      ! on garde la difference entre les 2 diagonales
      v1(:,1)=v1(:,1)-v2(:,1)
      open(99,form='unformatted',status='unknown')
      call ecr8bl(v1(:,1),ndet,99)
      ! Modification des M-1 HPsi precedents
      do i=1,M2
         ! Lecture de H*Psi, H de l'iteration precedente
         !print*,'coucou3'
         call lire(v2(:,1),i,ndet,22)
         !print*,'coucou4'
!         do k=1,ndet
!            print'(a,f12.8)','hPsi avant',v2(k,1)
!         enddo
         ! Lecture de Psi
         !print*,'coucou5'
         call lire(v1(:,1),i,ndet,21)
         !print*,'coucou6'
         ! Correction de H*Psi
!         print*,'DP0',dot_product(v2(:,1),v1(:,1))
         ifin=0
         rewind 99
         do k=1,ndet,2048
            ideb=ifin+1
            ifin=min(ifin+2048,ndet)
            read(99) vhab2(1:ifin-ideb+1)
            v2(ideb:ifin,1)=v2(ideb:ifin,1)+
     *      vhab2(1:ifin-ideb+1)*v1(ideb:ifin,1)
         enddo
!         do k=1,ndet
!            print'(a,2i4,4f12.8)','hPsi apres',i,k,v1(:,1)(k),v1(k,1),
!     *      v2(k,1),v1(k,1)*v1(:,1)(k)
!         enddo
!         print*,'DP1',dot_product(v2(:,1),v1(:,1))
         call ecr(v2(:,1),i,ndet,22)
         !print*,'coucou7'
         call lire(v2(:,1),i,ndet,22)
         !print*,'coucou8'
!         do k=1,ndet
!            print'(a,f12.8)','hPsi avant1',v2(k,1)
!         enddo
      enddo
      close(99,status='delete')
      return
      end
      
       subroutine diaghab4(nt,np,mhab,delta,ninac,noac,
     *nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
!
!--------------------------------------------------
! Habillage cas igener==4 (ICSD)
!--------------------------------------------------
!
      implicit none
      double precision :: delta(8)
      double precision,dimension(ndet,maxl0) :: v1
      real(8) sdelta,
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2
      data 
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2 /24*0.d0/
      integer nt,np,ntnp,mhab,ninac,noac,nelac,nvirt,ideb,ifin,ndet,
     *maxl0,nonac2,nvirt2,noac2
     *,nplaces,nplaces1,nplaces2,nplaces3,nplaces_1,nplaces_2,nplaces_3
     *,nelac1,nelac2,nelac3
     *,nelac_1,nelac_2,nelac_3
     *,ninac2,ninac_1,ninac_2,ninac_3,nvirt_1,nvirt_2,nvirt_3
      ntnp=nt+np
      if(mhab==1) then
         if(ntnp==0) then
            sdelta=0.d0
         else
            sdelta=sum(delta)
         endif
      else if(mhab==2) then
         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
            if(nt==1) then
               sdelta=delta(1)+delta(2)+delta(3)
            else
               sdelta=delta(1)+delta(4)+delta(7)
            endif
         else if(ntnp==2) then
            if(nt==1) then
               sdelta=sum(delta((/1,2,3,4,7/)))
            else if(nt==0) then
               sdelta=sum(delta((/1,2,4,5,7,8/)))
            else if(nt==2) then
               sdelta=sum(delta((/1,2,3,4,5,6/)))
            endif
         else if(ntnp==3) then
            if(nt==1) then
               sdelta=sum(delta((/1,2,3,4,5,7,8/)))
            else
               sdelta=sum(delta((/1,2,3,4,5,6,7/)))
            endif
         else if(ntnp==4) then
            sdelta=sum(delta)
         endif
      else if(mhab==3) then
         ninac2=2*ninac
         ninac_1=max(ninac2-1,0)
         ninac_2=max(ninac2-2,0)
         ninac_3=max(ninac2-3,0)
         nvirt2=nvirt*2
         nvirt_1=max(nvirt2-1,0)
         nvirt_2=max(nvirt2-2,0)
         nvirt_3=max(nvirt2-3,0)
         nelac_1=max(nelac-1,0)
         nelac_2=max(nelac-2,0)
         nelac_3=max(nelac-3,0)
         nelac1=min(nelac+1,noac*2)
         nelac2=min(nelac+2,noac*2)
         nelac3=min(nelac+3,noac*2)
         nplaces=noac*2-nelac
         nplaces_1=max(nplaces-1,0)
         nplaces_2=max(nplaces-2,0)
         nplaces_3=max(nplaces-3,0)
         nplaces1=min(nplaces+1,noac*2)
         nplaces2=min(nplaces+2,noac*2)
         nplaces3=min(nplaces+3,noac*2)
! tmtn : on rajoute m trous, il y en avait n
         if(ninac>=1) t1t1=1.d0*(ninac_1)/ninac2
         if(ninac>=1) t2t1=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t1t2=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t2t2=1.d0*(ninac_2*ninac_3)
     *   /(ninac2*ninac_1)
! pmpn : on rajoute m part, il y en avait n
         if(nvirt>=1) p1p1=1.d0*(nvirt_1)/nvirt2
         if(nvirt>=1) p2p1=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p1p2=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p2p2=1.d0*(nvirt_2*nvirt_3)
     *   /(nvirt2*nvirt_1)
!         p1p1=1.d0*(nvirt_1)/nvirt2
!         p2p1=(1.d0*(nvirt_1)/nvirt2)**2
!         p1p2=1.d0*(nvirt_2)/nvirt2
!         p2p2=(1.d0*(nvirt_2)/nvirt2)**2
!

         !(=C(2*N-2,2)/C(2*N,2))
! aman : on rajoute m electrons act dans un CAS a +n el
! bmbn : on retire m electrons act d'un CAS a +n el
         if(nplaces>=1) a1a1=1.d0*(nplaces_1)/nplaces
         if(nplaces>=1) a2a1=1.d0*(nplaces_2)/nplaces
         if(nplaces>=1) a1a2=1.d0*(nplaces_2)/nplaces
         if(nplaces>=2) a2a2=1.d0*(nplaces_2*nplaces_3)
     *   /(nplaces*nplaces_1)
         if(nelac>=1) a_1a_1=1.d0*(nelac_1)/nelac
         if(nelac>=2) a_2a_1=1.d0*(nelac_2)/nelac
         if(nelac>=1) a_1a_2=1.d0*(nelac_2)/nelac
         if(nelac>=2) a_2a_2=1.d0*(nelac_2*nelac_3)
     *   /(nelac*nelac_1)
         if(nplaces>=1) a1a_1=1.d0*(nplaces1)/nplaces
         if(nplaces>=2) a2a_1=1.d0*(nplaces1)/nplaces_1
         if(nplaces>=1) a1a_2=1.d0*(nplaces2)/nplaces
         if(nplaces>=2) a2a_2=1.d0*(nplaces2*nplaces1)
     *   /nplaces*(nplaces_1)
         if(nelac>=1) a_1a1=1.d0*(nelac1)/nelac
         if(nelac>=2) a_2a1=1.d0*(nelac1)/nelac_1
         if(nelac>=1) a_1a2=1.d0*(nelac2)/nelac
         if(nelac>=2) a_2a2=1.d0*(nelac2*nelac1)
     *   /nelac*(nelac_1)

!         a1a1=1.d0*(nplaces_1)/nplaces
!         a2a1=(1.d0*(nplaces_1)/nplaces)**2
!         a1a2=1.d0*(nplaces_2)/nplaces
!         a2a2=(1.d0*(nplaces_2)/nplaces)**2
!         a_1a_1=1.d0*(nelac_1)/nelac
!         a_2a_1=1.d0*(nelac_1)/nelac**2
!         a_1a_2=1.d0*(nelac_2)/nelac
!         a_2a_2=1.d0*(nelac_2)/nelac**2
!         a1a_1=1.d0*(nplaces1)/nplaces
!         a2a_1=(1.d0*(nplaces1)/nplaces)**2
!         a1a_2=1.d0*(nplaces2)/nplaces
!         a2a_2=(1.d0*(nplaces2)/nplaces)**2
!         a_1a1=1.d0*(nelac1)/nelac
!         a_2a1=1.d0*(nelac1)/nelac**2
!         a_1a2=1.d0*(nelac2)/nelac
!         a_2a2=1.d0*(nelac2)/nelac**2

         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
! hab=1 2t 2p
! hab=2 2t 1p
! hab=3 2t 0p
! hab=4 1t 2p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p+
            if(nt==1) then
               sdelta=delta(1)*t2t1
     *         +delta(2)*t2t1*a1a1
     *         +delta(3)*t2t1*a2a1
            else
               sdelta=delta(1)*p2p1
     *         +delta(4)*p2p1*a_1a_1
     *         +delta(7)*p2p1*a_2a_1
            endif
         else if(ntnp==2) then
            if(nt==1) then
               sdelta=delta(1)*t2t1*p2p1
     *         +delta(2)*t2t1*p1p1
     *         +delta(3)*t2t1
     *         +delta(4)*t1t1*p2p1
     *         +delta(7)*p2p1
            else if(nt==0) then
               sdelta=delta(1)*p2p2
     *         +delta(2)*p1p2*a1a_2
     *         +delta(4)*p2p2*a_1a_2
     *         +delta(5)*p1p2
     *         +delta(7)*p2p2*a_2a_2
     *         +delta(8)*p1p2*a_1a_2
            else if(nt==2) then
               sdelta=delta(1)*t2t2
     *         +delta(2)*t2t2*a1a2
     *         +delta(3)*t2t2*a2a2
     *         +delta(4)*t1t2*a_1a2
     *         +delta(5)*t1t2
     *         +delta(6)*t1t2*a1a2
            endif
         else if(ntnp==3) then
! hab=1 2t 2p
! hab=2 2t 1p
! hab=3 2t 0p
! hab=4 1t 2p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p
            if(nt==1) then
               sdelta=delta(1)*t2t1*p2p2
     *         +delta(2)*t2t1*p1p2*a1a_1
     *         +delta(3)*t2t1*a2a_1
     *         +delta(4)*t1t1*p2p2*a_1a_1
     *         +delta(5)*t1t1*p1p2
     *         +delta(7)*p2p2*a_2a_1
     *         +delta(8)*p1p2*a_1a_1
            else
               sdelta=delta(1)*t2t2*p2p1
     *         +delta(2)*t2t2*p1p1*a1a1
     *         +delta(3)*t2t2*a2a1
     *         +delta(4)*t1t2*p2p1*a_1a1
     *         +delta(5)*t1t2*p1p1
     *         +delta(6)*t1t2*a1a1
     *         +delta(7)*p2p1*a1a1
            endif
         else if(ntnp==4) then
               sdelta=delta(1)*t2t2*p2p2
     *         +delta(2)*t2t2*p1p2
     *         +delta(3)*t2t2
     *         +delta(4)*t1t2*p2p2
     *         +delta(5)*t1t2*p1p2
     *         +delta(6)*t1t2
     *         +delta(7)*p2p2
     *         +delta(8)*p1p2
         endif
      endif
c     print*,'delta=',delta
      v1(ideb:ifin,1)=v1(ideb:ifin,1)+sdelta
      return
      end
      
       subroutine diaghab3(nt,np,mhab,delta,ninac,noac,
     *nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
!
!--------------------------------------------------
! Habillage cas igener==3 (DDCI)
!--------------------------------------------------
!
      implicit none
      double precision :: delta(8)
      double precision,dimension(ndet,maxl0) :: v1
      real(8) sdelta,
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2
      data 
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2 /24*0.d0/
      integer nt,np,ntnp,mhab,ninac,noac,nelac,nvirt,ideb,ifin,ndet,
     *maxl0,nonac2,nvirt2,noac2
     *,nplaces,nplaces1,nplaces2,nplaces3,nplaces_1,nplaces_2,nplaces_3
     *,nelac1,nelac2,nelac3
     *,nelac_1,nelac_2,nelac_3
     *,ninac2,ninac_1,ninac_2,ninac_3,nvirt_1,nvirt_2,nvirt_3
      logical yw
      ntnp=nt+np
! hab=2 2t 1p
! hab=3 2t 0p
! hab=4 1t 2p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p+
      if(mhab==1) then
         if(ntnp==0) then
            sdelta=0.d0
         else
            sdelta=sum(delta(2:8))
         endif
      else if(mhab==2) then
         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
            if(nt==1) then
               sdelta=delta(4)+delta(2)+delta(3)
            else
               sdelta=delta(2)+delta(4)+delta(7)
            endif
         else if(ntnp==2) then
            if(nt==1) then
               sdelta=sum(delta((/5,2,3,4,7/)))
            else if(nt==0) then
               sdelta=sum(delta((/3,2,4,5,7,8/)))
            else if(nt==2) then
               sdelta=sum(delta((/7,2,3,4,5,6/)))
            endif
         else if(ntnp==3) then
            if(nt==1) then
               sdelta=sum(delta((/6,2,3,4,5,7,8/)))
            else
               sdelta=sum(delta((/8,2,3,4,5,6,7/)))
            endif
         endif
      else if(mhab==3) then
         ninac2=2*ninac
         ninac_1=max(ninac2-1,0)
         ninac_2=max(ninac2-2,0)
         ninac_3=max(ninac2-3,0)
         nvirt2=nvirt*2
         nvirt_1=max(nvirt2-1,0)
         nvirt_2=max(nvirt2-2,0)
         nvirt_3=max(nvirt2-3,0)
         nelac_1=max(nelac-1,0)
         nelac_2=max(nelac-2,0)
         nelac_3=max(nelac-3,0)
         nelac1=min(nelac+1,noac*2)
         nelac2=min(nelac+2,noac*2)
         nelac3=min(nelac+3,noac*2)
         nplaces=noac*2-nelac
         nplaces_1=max(nplaces-1,0)
         nplaces_2=max(nplaces-2,0)
         nplaces_3=max(nplaces-3,0)
         nplaces1=min(nplaces+1,noac*2)
         nplaces2=min(nplaces+2,noac*2)
         nplaces3=min(nplaces+3,noac*2)
! tmtn : on rajoute m trous, il y en avait n
         if(ninac>=1) t1t1=1.d0*(ninac_1)/ninac2
         if(ninac>=1) t2t1=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t1t2=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t2t2=1.d0*(ninac_2*ninac_3)
     *   /(ninac2*ninac_1)
! pmpn : on rajoute m part, il y en avait n
         if(nvirt>=1) p1p1=1.d0*(nvirt_1)/nvirt2
         if(nvirt>=1) p2p1=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p1p2=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p2p2=1.d0*(nvirt_2*nvirt_3)
     *   /(nvirt2*nvirt_1)
! aman : on rajoute m electrons act dans un CAS a +n el
! bmbn : on retire m electrons act d'un CAS a +n el
         if(nplaces>=1) a1a1=1.d0*(nplaces_1)/nplaces
         if(nplaces>=1) a2a1=1.d0*(nplaces_2)/nplaces
         if(nplaces>=1) a1a2=1.d0*(nplaces_2)/nplaces
         if(nplaces>=2) a2a2=1.d0*(nplaces_2*nplaces_3)
     *   /(nplaces*nplaces_1)
         if(nelac>=1) a_1a_1=1.d0*(nelac_1)/nelac
         if(nelac>=2) a_2a_1=1.d0*(nelac_2)/nelac
         if(nelac>=1) a_1a_2=1.d0*(nelac_2)/nelac
         if(nelac>=2) a_2a_2=1.d0*(nelac_2*nelac_3)
     *   /(nelac*nelac_1)
         if(nplaces>=1) a1a_1=1.d0*(nplaces1)/nplaces
         if(nplaces>=2) a2a_1=1.d0*(nplaces1)/nplaces_1
         if(nplaces>=1) a1a_2=1.d0*(nplaces2)/nplaces
         if(nplaces>=2) a2a_2=1.d0*(nplaces2*nplaces1)
     *   /nplaces*(nplaces_1)
         if(nelac>=1) a_1a1=1.d0*(nelac1)/nelac
         if(nelac>=2) a_2a1=1.d0*(nelac1)/nelac_1
         if(nelac>=1) a_1a2=1.d0*(nelac2)/nelac
         if(nelac>=2) a_2a2=1.d0*(nelac2*nelac1)
     *   /nelac*(nelac_1)


         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
! hab=2 2t 1p
! hab=3 2t 0p
! hab=4 1t 2p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p+
            if(nt==1) then
               sdelta=delta(4)*t1t1*a_1a1
     *         +delta(2)*t2t1*a1a1
     *         +delta(3)*t2t1*a2a1
            else
               sdelta=delta(2)*p1p1*a1a_1
     *         +delta(4)*p2p1*a_1a_1
     *         +delta(7)*p2p1*a_2a_1
            endif
         else if(ntnp==2) then
            if(nt==1) then
               sdelta=delta(5)*t1t1*p1p1
     *         +delta(2)*t2t1*p1p1
     *         +delta(3)*t2t1
     *         +delta(4)*t1t1*p2p1
     *         +delta(7)*p2p1
            else if(nt==0) then
               sdelta=delta(3)*a2a_2
     *         +delta(2)*p1p2*a1a_2
     *         +delta(4)*p2p2*a_1a_2
     *         +delta(5)*p1p2
     *         +delta(7)*p2p2*a_2a_2
     *         +delta(8)*p1p2*a_1a_2
            else if(nt==2) then
               sdelta=delta(7)*a_2a2
     *         +delta(2)*t2t2*a1a2
     *         +delta(3)*t2t2*a2a2
     *         +delta(4)*t1t2*a_1a2
     *         +delta(5)*t1t2
     *         +delta(6)*t1t2*a1a2
            endif
         else if(ntnp==3) then
! hab=2 2t 1p
! hab=3 2t 0p
! hab=4 1t 2p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p
            if(nt==1) then
               sdelta=delta(6)*t1t1*a1a_1
     *         +delta(2)*t2t1*p1p2*a1a_1
     *         +delta(3)*t2t1*a2a_1
     *         +delta(4)*t1t1*p2p2*a_1a_1
     *         +delta(5)*t1t1*p1p2
     *         +delta(7)*p2p2*a_2a_1
     *         +delta(8)*p1p2*a_1a_1
            else
               sdelta=delta(8)*p1p1*a_1a1
     *         +delta(2)*t2t2*p1p1*a1a1
     *         +delta(3)*t2t2*a2a1
     *         +delta(4)*t1t2*p2p1*a_1a1
     *         +delta(5)*t1t2*p1p1
     *         +delta(6)*t1t2*a1a1
     *         +delta(7)*p2p1*a_2a1
            endif
         endif
      endif
c     print*,'delta=',delta
      if(yw)print*,'t1t1...',
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2
      v1(ideb:ifin,1)=v1(ideb:ifin,1)+sdelta
      return
      end
      
       subroutine diaghab2(nt,np,mhab,delta,ninac,noac,
     *nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
!
!--------------------------------------------------
! Habillage cas igener==2 (DDC2)
!--------------------------------------------------
!
      implicit none
      double precision :: delta(8)
      double precision,dimension(ndet,maxl0) :: v1
      real(8) sdelta,
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2
      data 
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2 /24*0.d0/
      integer nt,np,ntnp,mhab,ninac,noac,nelac,nvirt,ideb,ifin,ndet,
     *maxl0,nonac2,nvirt2,noac2
     *,nplaces,nplaces1,nplaces2,nplaces3,nplaces_1,nplaces_2,nplaces_3
     *,nelac1,nelac2,nelac3
     *,nelac_1,nelac_2,nelac_3
     *,ninac2,ninac_1,ninac_2,ninac_3,nvirt_1,nvirt_2,nvirt_3
      ntnp=nt+np
! hab=3 2t 0p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p+
      if(mhab==1) then
         if(ntnp==0) then
            sdelta=0.d0
         else
            sdelta=delta(3)+delta(5)+delta(6)+delta(7)+delta(8)
         endif
      else if(mhab==2) then
         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
            sdelta=delta(3)+delta(5)+delta(7)
         else if(ntnp==2) then
            sdelta=sum(delta((/3,5,6,7,8/)))
         endif
      else if(mhab==3) then
         ninac2=2*ninac
         ninac_1=max(ninac2-1,0)
         ninac_2=max(ninac2-2,0)
         ninac_3=max(ninac2-3,0)
         nvirt2=nvirt*2
         nvirt_1=max(nvirt2-1,0)
         nvirt_2=max(nvirt2-2,0)
         nvirt_3=max(nvirt2-3,0)
         nelac_1=max(nelac-1,0)
         nelac_2=max(nelac-2,0)
         nelac_3=max(nelac-3,0)
         nelac1=min(nelac+1,noac*2)
         nelac2=min(nelac+2,noac*2)
         nelac3=min(nelac+3,noac*2)
         nplaces=noac*2-nelac
         nplaces_1=max(nplaces-1,0)
         nplaces_2=max(nplaces-2,0)
         nplaces_3=max(nplaces-3,0)
         nplaces1=min(nplaces+1,noac*2)
         nplaces2=min(nplaces+2,noac*2)
         nplaces3=min(nplaces+3,noac*2)
! tmtn : on rajoute m trous, il y en avait n
         if(ninac>=1) t1t1=1.d0*(ninac_1)/ninac2
         if(ninac>=1) t2t1=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t1t2=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t2t2=1.d0*(ninac_2*ninac_3)
     *   /(ninac2*ninac_1)
! pmpn : on rajoute m part, il y en avait n
         if(nvirt>=1) p1p1=1.d0*(nvirt_1)/nvirt2
         if(nvirt>=1) p2p1=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p1p2=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p2p2=1.d0*(nvirt_2*nvirt_3)
     *   /(nvirt2*nvirt_1)
! aman : on rajoute m electrons act dans un CAS a +n el
! bmbn : on retire m electrons act d'un CAS a +n el
         if(nplaces>=1) a1a1=1.d0*(nplaces_1)/nplaces
         if(nplaces>=1) a2a1=1.d0*(nplaces_2)/nplaces
         if(nplaces>=1) a1a2=1.d0*(nplaces_2)/nplaces
         if(nplaces>=2) a2a2=1.d0*(nplaces_2*nplaces_3)
     *   /(nplaces*nplaces_1)
         if(nelac>=1) a_1a_1=1.d0*(nelac_1)/nelac
         if(nelac>=2) a_2a_1=1.d0*(nelac_2)/nelac
         if(nelac>=1) a_1a_2=1.d0*(nelac_2)/nelac
         if(nelac>=2) a_2a_2=1.d0*(nelac_2*nelac_3)
     *   /(nelac*nelac_1)
         if(nplaces>=1) a1a_1=1.d0*(nplaces1)/nplaces
         if(nplaces>=2) a2a_1=1.d0*(nplaces1)/nplaces_1
         if(nplaces>=1) a1a_2=1.d0*(nplaces2)/nplaces
         if(nplaces>=2) a2a_2=1.d0*(nplaces2*nplaces1)
     *   /nplaces*(nplaces_1)
         if(nelac>=1) a_1a1=1.d0*(nelac1)/nelac
         if(nelac>=2) a_2a1=1.d0*(nelac1)/nelac_1
         if(nelac>=1) a_1a2=1.d0*(nelac2)/nelac
         if(nelac>=2) a_2a2=1.d0*(nelac2*nelac1)
     *   /nelac*(nelac_1)


         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
! hab=3 2t 0p
! hab=5 1t 1p
! hab=6 1t 0p
! hab=7 0t 2p
! hab=8 0t 1p+
            if(nt==1) then
               sdelta=delta(5)*t1t1
     *         +delta(3)*t2t1*a2a1
     *         +delta(7)*a_2a1
            else
               sdelta=delta(3)*a2a_1
     *         +delta(5)*p1p1
     *         +delta(7)*p2p1*a_2a_1
            endif
         else if(ntnp==2) then
            if(nt==1) then
               sdelta=delta(5)*t1t1*p1p1
     *         +delta(3)*t2t1
     *         +delta(7)*p2p1
     *         +delta(6)*t1t1
     *         +delta(8)*p1p1
            else if(nt==0) then
               sdelta=delta(3)*a2a_2
     *         +delta(5)*p1p2
     *         +delta(7)*p2p2*a_2a_2
     *         +delta(8)*p1p2*a_1a_2
     *         +delta(6)*a1a_2
            else if(nt==2) then
               sdelta=delta(8)*a_1a2
     *         +delta(3)*t2t2*a2a2
     *         +delta(5)*t1t2
     *         +delta(6)*t1t2*a1a2
     *         +delta(7)*a_2a2
            endif
         endif
      endif
c     print*,'delta=',delta
      v1(ideb:ifin,1)=v1(ideb:ifin,1)+sdelta
      return
      end
      
       subroutine diaghab1(nt,np,mhab,delta,ninac,noac,
     *nelac,nvirt,ideb,ifin,v1,ndet,maxl0)
!
!--------------------------------------------------
! Habillage cas igener==1 (ICS)
!--------------------------------------------------
!
      implicit none
      double precision :: delta(8)
      double precision,dimension(ndet,maxl0) :: v1
      real(8) sdelta,
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2
      data 
     *t1t1, t2t1, t1t2, t2t2,
     *p1p1, p2p1, p1p2, p2p2,
     *a1a1, a2a1, a1a2, a2a2,
     *a_1a_1, a_2a_1, a_1a_2, a_2a_2,
     *a_1a1, a_2a1, a_1a2, a_2a2,
     *a1a_1, a2a_1, a1a_2, a2a_2 /24*0.d0/
      integer nt,np,ntnp,mhab,ninac,noac,nelac,nvirt,ideb,ifin,ndet,
     *maxl0,nonac2,nvirt2,noac2
     *,nplaces,nplaces1,nplaces2,nplaces3,nplaces_1,nplaces_2,nplaces_3
     *,nelac1,nelac2,nelac3
     *,nelac_1,nelac_2,nelac_3
     *,ninac2,ninac_1,ninac_2,ninac_3,nvirt_1,nvirt_2,nvirt_3
      ntnp=nt+np
! hab=5 1t 1p
! hab=6 1t 0p
! hab=8 0t 1p+
      if(mhab==1) then
         if(ntnp==0) then
            sdelta=0.d0
         else
            sdelta=delta(5)+delta(6)+delta(8)
         endif
      else if(mhab==2) then
         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
            if(nt==1) then
               sdelta=delta(5)+delta(6)
            else
               sdelta=delta(8)+delta(5)
            endif
         else if(ntnp==2) then
            sdelta=sum(delta((/5,6,8/)))
         endif
      else if(mhab==3) then
         ninac2=2*ninac
         ninac_1=max(ninac2-1,0)
         ninac_2=max(ninac2-2,0)
         ninac_3=max(ninac2-3,0)
         nvirt2=nvirt*2
         nvirt_1=max(nvirt2-1,0)
         nvirt_2=max(nvirt2-2,0)
         nvirt_3=max(nvirt2-3,0)
         nelac_1=max(nelac-1,0)
         nelac_2=max(nelac-2,0)
         nelac_3=max(nelac-3,0)
         nelac1=min(nelac+1,noac*2)
         nelac2=min(nelac+2,noac*2)
         nelac3=min(nelac+3,noac*2)
         nplaces=noac*2-nelac
         nplaces_1=max(nplaces-1,0)
         nplaces_2=max(nplaces-2,0)
         nplaces_3=max(nplaces-3,0)
         nplaces1=min(nplaces+1,noac*2)
         nplaces2=min(nplaces+2,noac*2)
         nplaces3=min(nplaces+3,noac*2)
! tmtn : on rajoute m trous, il y en avait n
         if(ninac>=1) t1t1=1.d0*(ninac_1)/ninac2
         if(ninac>=1) t2t1=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t1t2=1.d0*(ninac_2)/ninac2
         if(ninac>=1) t2t2=1.d0*(ninac_2*ninac_3)
     *   /(ninac2*ninac_1)
! pmpn : on rajoute m part, il y en avait n
         if(nvirt>=1) p1p1=1.d0*(nvirt_1)/nvirt2
         if(nvirt>=1) p2p1=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p1p2=1.d0*(nvirt_2)/nvirt2
         if(nvirt>=1) p2p2=1.d0*(nvirt_2*nvirt_3)
     *   /(nvirt2*nvirt_1)
! aman : on rajoute m electrons act dans un CAS a +n el
! bmbn : on retire m electrons act d'un CAS a +n el
         if(nplaces>=1) a1a1=1.d0*(nplaces_1)/nplaces
         if(nplaces>=1) a2a1=1.d0*(nplaces_2)/nplaces
         if(nplaces>=1) a1a2=1.d0*(nplaces_2)/nplaces
         if(nplaces>=2) a2a2=1.d0*(nplaces_2*nplaces_3)
     *   /(nplaces*nplaces_1)
         if(nelac>=1) a_1a_1=1.d0*(nelac_1)/nelac
         if(nelac>=2) a_2a_1=1.d0*(nelac_2)/nelac
         if(nelac>=1) a_1a_2=1.d0*(nelac_2)/nelac
         if(nelac>=2) a_2a_2=1.d0*(nelac_2*nelac_3)
     *   /(nelac*nelac_1)
         if(nplaces>=1) a1a_1=1.d0*(nplaces1)/nplaces
         if(nplaces>=2) a2a_1=1.d0*(nplaces1)/nplaces_1
         if(nplaces>=1) a1a_2=1.d0*(nplaces2)/nplaces
         if(nplaces>=2) a2a_2=1.d0*(nplaces2*nplaces1)
     *   /nplaces*(nplaces_1)
         if(nelac>=1) a_1a1=1.d0*(nelac1)/nelac
         if(nelac>=2) a_2a1=1.d0*(nelac1)/nelac_1
         if(nelac>=1) a_1a2=1.d0*(nelac2)/nelac
         if(nelac>=2) a_2a2=1.d0*(nelac2*nelac1)
     *   /nelac*(nelac_1)


         if(ntnp==0) then
            sdelta=0.d0
         else if(ntnp==1) then
! hab=5 1t 1p
! hab=6 1t 0p
! hab=8 0t 1p+
            if(nt==1) then
               sdelta=delta(5)*t1t1
     *         +delta(6)*t1t1*a1a1
            else
               sdelta=delta(5)*p1p1
     *         +delta(8)*p1p1*a_1a_1
            endif
         else if(ntnp==2) then
            sdelta=delta(5)*t1t1*p1p1
     *      +delta(6)*t1t1
     *      +delta(8)*p1p1
         endif
      endif
c     print*,'delta=',delta
      v1(ideb:ifin,1)=v1(ideb:ifin,1)+sdelta
      return
      end
      
