      subroutine suivi
      use module
      implicit real(8) (a-h,o-x,z),logical(y)
      logical,save :: y_passage_dans_suiv=.true.
      yw=.true.
! on stocke les vecteurs d'essai sur file (on ne doit le faire
! qu'une fois !)
      if(.not.y_passage_dans_suiv) return
      open(99,file='STOESS',form='unformatted',status='unknown')
      do k=1,nvec
         call lire(v1(:,k),k,ndet,21)
      enddo
      write(99) nvec
      write(99) v1
      close(99)
      if(yw) then
         do k=1,ndet
            if(any(abs(v1(k,:))>1.d-1)) print'(a,i6,10f10.6)',
     *      'SUIVI',k,v1(k,:)
         enddo
      endif
      ysuiv2=.true.
      y_passage_dans_suiv=.false.
      return
      end
       subroutine suivi2!(ysuiv2)
      use module
      use mod_script
      use mod_lirint
      use mod_gen
C     use mod_dav
      implicit real(8) (a-h,o-x,z),logical(y)
      allocatable ps(:,:)
      allocatable iord(:),alam(:)
!
!---------------------------------------------------------
! Suivi des vecteurs d'essai
! on entre ici apres la fin d'un calcul casdiloc
!---------------------------------------------------------
!
      yw=.true.
      call titre('Suivi des vecteurs d''essai#',40)
! Lecture des vecteurs d'essai initiaux
      open(99,file='STOESS',form='unformatted',status='old')
      read(99) nvec_orig
      read(99) v1(:,1:nvec_orig)
      close(99)
C      call lire(v2(:,:),1,ndet*nvec,21)
      if(yw) then
         do k=1,ndet
            if(any(abs(v2(k,:))>1.d-1)) print'(a,i6,10f10.6)',
     *      'SUIVI2',k,v2(k,:)
         enddo
      endif
! Lecture des vecteurs converges
      rewind 11
      read(11)
      read(11)
      do ivec=1,nvec
         read(11) v2(:,ivec)
      enddo
      print*,' '
      if(yw) then
         do k=1,ndet
            if(any(abs(v2(k,:))>1.d-1)) print'(a,i6,10f10.6)',
     *      'SUIVI1',k,v1(k,:)
         enddo
         do k=1,ndet
            if(any(abs(v2(k,:))>1.d-1)) print'(a,i6,10f10.6)',
     *      'SUIVI2',k,v2(k,:)
         enddo
      endif
! Produits scalaires entre vect d'essai et vect converges
      allocate(ps(nvec_orig,nvec))
      do i=1,nvec_orig
         do j=1,nvec
            ps(i,j)=dot_product(v1(:,i),v2(:,j))
         enddo
      enddo
      print*,'Produits scalaires'
      call mscript(ps)
!
! nb de vecteurs correspondant aux vecteurs d'essai
      nv=0
      do i=1,nvec_orig
         if(any(abs(ps(i,:))>suiv)) nv=nv+1
      enddo
      print*,'nb de vecteurs correspondant aux vecteurs d''essai',nv
      if(nv==nvec_orig) then
         print*,'Tous les vecteurs ont ete trouves'
! Tous les vecteurs ont ete trouves. Il faut maintenant trouver
! leurs numeros. On genere le fichier davec de sortie
         allocate(iord(nvec_orig))
         do i=1,nvec_orig
            amax=0.d0
            do j=1,nvec
               amaxv=amax
               amax=max(amax,abs(ps(i,j)))
               if(amax>amaxv) loc=j
            enddo
            if(amax>suiv) then
               iord(i)=loc
            else
               print*,'Pas de recouvrement >',suiv,'   trouve'
               stop
            endif
         enddo
         print*,'vecteurs a conserver :'
         print*,iord
         rewind 11
         read(11)
         allocate(alam(nvec))
         read(11) (alam(kk),kk=1,nvec),enuc,eref
         rewind 11
         write(11) ndet,nvec_orig
         write(11) (alam(iord(kk)),kk=1,nvec_orig),enuc,eref
         DO kk=1,NVEC_orig
            WRITE(11) v2(:,iord(kk))
         enddo
         ysuiv2=.false.
         return
      endif
! on transmet l'info qu'il faut continuer
      ysuiv2=.true.
      close(99)
      print*,'Numeros des vecteurs d''essai perdus :'
      do i=1,nvec_orig
         if(all(abs(ps(i,:))<=suiv)) print*,i
      enddo
      print*,'------------------------:'
      print*,' '
!
!--------------------------------------------
! Preparation du lancement du calcul suivant
!--------------------------------------------
! On ajoute les vecteurs d'essai non trouves
      n=0
      do i=1,nvec_orig
         if(all(abs(ps(i,:))<=suiv)) then
            ! orthogonalisation aux premiers vecteurs d'essai
            n=n+1
            do j=1,nvec
               v1(:,n)=v1(:,n)-dot_product(v1(:,n),v2(:,j))*v2(:,j)
            enddo
            do j=1,i-1
               v1(:,n)=v1(:,n)-dot_product(v1(:,n),v1(:,j))*v1(:,j)
            enddo
            ! renormalisation
            v1(:,n)=v1(:,n)/sqrt(dot_product(v1(:,n),v1(:,n)))
            call ecr(v1(:,n),n+nvec,ndet,21)
         endif
      enddo
!
! On met en vecteurs d'essai les bons vecteurs deja converges
c      do i=1,nvec
c         call ecr(v2(:,i),i,ndet,21)
c      enddo
      ess1='TMP_SUIVI'
      open(99,file=ess1,form='unformatted',status='unknown')
       print*,'ecriture sur 99',ndet,nvec
      write(99) ndet,nvec
      write(99) 0.d0
      do ivec=1,nvec
         write(99) v2(:,ivec)
      enddo
      do ivec=1,nvec-nv
         write(99) v1(:,ivec)
      enddo
      close(99)
      if(yw) then
         print*,'V2'
         call mscript(v2)
         call mscript(v1(:,1:nvec-nv))
      endif
! Dimension de la nouvelle IC :
      nvec=nvec+nvec_orig-nv
      if(nvec>nsuiv) then
         call titre('SUIVI#L''espace maximal est atteint'//
     *   ' sans avoir trouve tous les vecteurs cherches#'//
     *   'Augmenter la valeur de nsuiv en donnee#',70)
         ysuiv2=.false.
         return
      endif
! On desalloue les tableaux alloues lors du calcul precedent
      deallocate(num1,ajk,aijjj)
      deallocate(iloo,ilpp,il,ilp)
      if(igener>0) deallocate(ilc,ilc1)
      if(gener/='CAS') deallocate(ilpair,itp1,itp2,itp3,itp4,ltp1)
      deallocate(idebliscond,ifinliscond,liscond)
      if(allocated(yl))deallocate(yl)
      deallocate(ibinc,idetc,mdetc1,mdetc2,msgnc)
      deallocate(f,hmono)
      yfin=.false.
      iidiag=0
      deallocate(itype,num_oav)
      deallocate(infosym,yysymdeja)
      deallocate(v1,v2)
      allocate(v1(ndet,nvec),v2(ndet,nvec))
      maxl0=nvec
      nessai=2
      v2=0.d0
      !deallocate(f)
 
 
      return
      end
