      subroutine purifica(s,coef,thr,nnew,nact2,zprt)
      implicit real*8 (A-H,O-Y),logical*1 (Z)
C
C
C     Questa subroutine calcola gli autovalori e autovettori
C     della matrice (simmetrica) coef utilizzando la metrica
C     s, ammettendo la presenza di dipendenze lineari nel
C     set di funzioni su cui sono scritte le matrici (in numero nact2).
C     In uscita nnew e` il numero di autovalori (equivalente alla 
C     dimensione della base), s(1:nnew,1) contiene gli autovalori
C     e coeff(1:nact2,1:nnew) contiene gli autovettori scritti sul
C     set di funzioni eventualmente linearmente dipendenti.
C
C
      dimension s(nact2,nact2),coef(nact2,nact2)
      allocatable w(:),work(:),caux(:,:)
      allocate(w(nact2))
      allocate(work(3*nact2))
      allocate(caux(1:nact2,1:nact2))
      if (abs(thr).eq.0.d0) thr=1.d-14
      zverbose=.false.
      if(zprt) zverbose=.true.
      print*,'s',s
      call dsyev('V','U',nact2,s,nact2,w,work,3*nact2,info)
      print*,'w',w
      if(info.ne.0)then
         print*,'something wrong in diagonalization: sub purifica'
         stop 'purifica'
      endif
      if(zverbose)then
      print*,'matrice metrica diagonalizzata con info=',info
      print*,'autovalori matrice metrica:'
      do i=1,nact2
        print '(i2,f14.8)',i,w(i)
      enddo
      print*,' '
      print*,'Analisi delle dipendenze lineari:'
      endif 

      ndep=0
      do i=1,nact2
         if(abs(w(i)).lt.thr)ndep=ndep+1
      enddo
      if (zprt) print '(a,i3,a)',' Ci sono',ndep,' dipendenze lineari'
      nnew=nact2-ndep
c--costruzione della matrice di trasformazione
      jnew=0
      do j=1,nact2
         if(abs(w(j)).ge.1.d-8)then
            jnew=jnew+1
            val=sqrt(w(j))
            do i=1,nact2
               caux(i,jnew)=s(i,j)/val
            enddo
         endif
      enddo
      if(zverbose)print*,'check: final jnew is',jnew
c---trasformazione della matrice K
c---moltiplico K(coef) per CAUX e metto il risultato in S
      call dsymm('L','U',nact2,nnew,1.d0,coef,nact2,caux,nact2,0.d0,s
     $     ,nact2)
c---moltiplico CAUX(tilde) per S e metto il risultato in coef
      call dgemm('T','N',nnew,nnew,nact2,1.d0,caux,nact2,s,nact2,0.d0
     $     ,coef,nact2)
c--diagonalizzo la matrice coef(hamiltoniana trasformata)
      call dsyev('V','U',nnew,coef,nact2,w,work,3*nact2,info)
      if(info.ne.0)then
         print*,'something wrong in diagonalization: sub v0pmod'
         stop 'v0pmod'
      endif
      if(zverbose)then
         print*,'diagonalization got info=',info
         print*,'eigenvalues:'
         do i=1,nnew
            print '(a,i2,a,f25.8)','eps(',i,')=',w(i)
         enddo
      endif
c--back transformation
c--moltiplico CAUX(nact2,nnew) per coef(nnew,nnew)
c-- e metto in S(nact2,nnew)
      call dgemm('N','N',nact2,nnew,nnew,1.d0,caux,nact2,coef,nact2,0.d0
     $     ,s,nact2)
      if (zverbose) then
      print*,'nuovi coefficienti'
      call matout(nact2,nnew,s,nact2,1.d0)
      call flush(6)
      endif
c--metto in coef i coefficienti trasformati (for clarity sake)
      do mu=1,nnew
         do i=1,nact2
            coef(i,mu)=s(i,mu)
         enddo
      enddo
      do i=1,nnew
      s(i,1)=w(i)
      enddo
      deallocate(w)
      deallocate(work)
      deallocate(caux)
      return
      end
