      subroutine ecrivec
      use module
C     use mod_dav
      use mod_gen
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      common/ecrv/nnn,kk,kvec
      double precision,allocatable,dimension(:) :: alam1
      allocate(alam1(nvec))
!      print*,'entree ecrivec'
      call flush(6)
      if(.not.allocated(v2)) allocate(v2(ndet,nvec))
      if(.not.allocated(v1)) allocate(v1(ndet,nvec))
      rewind 11
      read(11)
      read(11) alam1
      call titre(' Energies, Vectors #',40)
      yfin=.true.
!      do k=1,nvec
!         print'(i3,f20.8)',k,alam1(k)+enuc+eref
!      enddo
      print*,' '
!   3-   6-  --> [-] -->    9-  11-    0.00000000
      do kvec1=1,nvec
         kvec=kvec1
         pcas=0.d0
         nnn=0
         !print*,'NNN=0'
         print'(a,i3,f22.12)','|  VECTEUR NUMERO',
     *   kvec,alam1(kvec)+enuc+eref
         read(11) v2(:,1)
         nn=0
         do iclc=1,nclasc
            !print*,'iclc',iclc,idebc(iclc),ifinc(iclc)
            if(.not.exist_clasc(iclc)) cycle
            !
            ! Boucle sur les det du CAS de la classe
            !
            do kc=idebc(iclc),ifinc(iclc)
               !
               ! Lecture du string CAS
               !
               bb=' '
               i=ibinc(kc)
               do k=1,noac
                  if(i==ibset(i,k-1)) then
                     if(i==ibset(i,k+16-1)) then
                        bb(18+k:18+k)='2'
                     else
                        bb(18+k:18+k)='+'
                     endif
                  else
                     if(i==ibset(i,k+16-1)) then
                        bb(18+k:18+k)='-'
                     else
                        bb(18+k:18+k)='0'
                     endif
                  endif
               enddo
               bb(18:18)='['
               bb(noac+19:noac+19)=']'
               !
               ! Calcul selectionne : distance du string CAS
               !
               if(sel==2) jdist=icaldist(kc,ibin,ibinc,noac)
               !
               ! Boucle sur les classes TP correspondant au CAS
               !
               do jcltp=1,nc_tp(iclc)
                  nn=nn+1
                  i=ic_tp(jcltp,iclc)
                  nta=icltp1(1,i)
                  ntb=icltp1(2,i)
                  npa=icltp1(3,i)
                  npb=icltp1(4,i)
                  nt=nta+ntb
                  np=npa+npb
                  ntnp=nt+np
                  if(sel==2) then
                     call lim_sel(nt,np,jdist,ibon)
                     if(ibon==0) cycle
                  endif
                  ! mise en place des spins dans la ligne
                  if(nta==1) then
                     bb(6:6)='+'
                     if(ntb==1) then
                        bb(11:11)='-'
                     endif
                  else if(nta==2) then
                     bb(6:6)='+'
                     bb(11:11)='+'
                  else if(ntb==1) then
                     bb(6:6)='-'
                  else if(ntb==2) then
                     bb(6:6)='-'
                     bb(11:11)='-'
                  endif
!   3-   6-  --> [-] -->    9-  11-    0.00000000
!-->    9-  11-    0.00000000
                  kk=19+noac
                  if(npa==1) then
                     bb(kk+10:kk+10)='+'
                     if(npb==1) then
                        bb(kk+15:kk+15)='-'
                     endif
                  else if(npa==2) then
                     bb(kk+10:kk+10)='+'
                     bb(kk+15:kk+15)='+'
                  else if(npb==1) then
                     bb(kk+10:kk+10)='-'
                  else if(npb==2) then
                     bb(kk+10:kk+10)='-'
                     bb(kk+15:kk+15)='-'
                  endif
                  ! generation des parties d'espace
                  if(nt>0) bb(14:16)='-->'
                  if(np>0) bb(kk+2:kk+4)='-->'
                  if(ntnp==0) then
                     if(ywcas) then
                        s_sv= twvec
                        twvec=0.0d0
                     endif
                     call gen_0
                     if(ywcas)  twvec=s_sv
                     pcas=pcas+v2(nnn,1)**2
                  else if(ntnp==1) then
                     if(nt==1) then
                        call gen_t
                     else
                        call gen_p
                     endif
                  else if(ntnp==2) then
                     if(nt==1) then
                        call gen_tp
                     else if(nt==0) then
                        call gen_pp
                     else if(nt==2) then
                        call gen_tt
                     endif
                  else if(ntnp==3) then
                     if(nt==1) then
                        call gen_tpp
                     else
                        call gen_ttp
                     endif
                  else if(ntnp==4) then
                     call gen_ttpp
                  endif
               enddo
            enddo
         enddo
         print*,' '
         print'(a,f12.8)',
     *   '| Poids du CAS (Somme des carres des determinants du CAS)'
     *   ,pcas
         print'(a,f12.8)',
     *   '                                         Racine carree :',
     *   dsqrt(pcas)
         print*,
     *   '   -----------------------------------------------------'
      enddo
      return
      end
       subroutine ecribb(kt,kp,jt,jp)
      use module
      use mod_gen
C     use mod_dav
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension jt(2),jp(2)
      common/ecrv/nnn,kk,kvec
!   3-   6-  --> [-] -->    9-  11-    0.00000000
!-->    9-  11-    0.00000000
      nnn=nnn+1
!      if(kt==0.and.kp==0) pcas=pcas+v2(nnn,1)**2
      if(ydens2) then
!         if(kt>0) then
!            write(bb(3:5),'(i3)') abs(jt(1))
!         endif
!         if(kt>1) then
!            write(bb(8:10),'(i3)') abs(jt(2))
!         endif
!         if(kp>0) then
!            write(bb(kk+7:kk+9),'(i3)') abs(jp(1))
!         endif
!         if(kp>1) then
!            write(bb(12+kk:14+kk),'(i3)') abs(jp(2))
!         endif
!         print'(a40,f10.6,20i4)',bb,v1(nnn,1),
!     *   ica(1:nca),1000000000000,icb(1:ncb),
!     *   100000000,it(1:nt),10000000000,ip(1:np)
         call dens2(nnn,kvec)
         return
      endif
      if(dabs(v2(nnn,1))< twvec) return
      if(kt>0) then
         write(bb(3:5),'(i3)') abs(jt(1))
      endif
      if(kt>1) then
         write(bb(8:10),'(i3)') abs(jt(2))
      endif
      if(kp>0) then
         write(bb(kk+7:kk+9),'(i3)') abs(jp(1))
      endif
      if(kp>1) then
         write(bb(12+kk:14+kk),'(i3)') abs(jp(2))
      endif
      write(bb(kk+18:kk+29),'(f12.8)') v2(nnn,1)
      if(abs(v2(nnn,1))>0.1d0) then
         print'(a1,a64,i10)','|',bb,nnn
      else
         print'(a1,a64,i10)',' ',bb,nnn
      endif
      return
      end
 
       subroutine ecrivec2(aa,ic)
      use module
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      character(16) d
      i=ibinc(ic)
      do k=1,noac
         if(i==ibset(i,k-1)) then
            if(i==ibset(i,k+16-1)) then
               d(k:k)='2'
            else
               d(k:k)='+'
            endif
         else
            if(i==ibset(i,k+16-1)) then
               d(k:k)='-'
            else
               d(k:k)='0'
            endif
         endif
      enddo
      if(.not.ywcas.and.abs(aa)>twvec)
     *print'(10x,2a,f12.8)','|'//d(1:noac)//'|','  ',aa
      return
      end
