!---------------------------------------------------------------------------
SUBROUTINE tchi_apply(nchir,ndim_tc,phi3,y3,t_chi_p,whichir,check_ir,ifirst,indexchi)
USE Numeric_Kinds_Module
USE CommonInfo_Module
USE APH_Module
USE Aph_Ham_Module
USE Cheby_Module
USE SymGroup_Module
IMPLICIT NONE

!==============================================================================
! I N P U T / O U T P U T
INTEGER,INTENT(IN) :: nchir, ndim_tc, whichir, check_ir, ifirst

REAL(dp),INTENT(IN)    :: phi3(nchir,nrho,ntheta)
REAL(dp),INTENT(INOUT) :: t_chi_p(nchir,nchir)
REAL(dp),INTENT(INOUT) :: y3(nchir,nrho,ntheta)

!==============================================================================
! I N T E R N A L S
CHARACTER(len=3) :: repname
CHARACTER(len=100) :: filename
INTEGER :: irho, jrho, itheta, ichi, indexchi
INTEGER :: i,j,ii, iichi, jjchi
INTEGER :: prev_num, k
REAL(dp) :: term

!==============================================================================
! Diagonalize T_chi and remove energies that are greater than vcut
! This diagonalizes the symmetrized t_chi and forms the chi hamiltonian from 
! basis vectors, one irreducible representation at a time.
!------------------------------------------------------------------------------

 IF (whichir.ne.check_ir) THEN

   DO j=1,nchir
     DO i=1,nchir
       t_chi_p(i,j)=t_chi(i+indexchi,j+indexchi)
     ENDDO
   ENDDO

  t_chi_temp=t_chi_p
  t_chi_clip=t_chi_p
  num_eig=0
  chi_eig=0.d0
  chi_evec=0.d0
  compr=0.d0
  compr_mat=0.d0
  tempeig=0.d0
  tempvcut=0.d0
  prev_num=nchir

  CALL repnames (whichir, group, repname)
  filename=TRIM(outdir)//'chi_'//repname
  CALL diag_out (nchir,t_chi_temp,chi_val,1.d0,1.d0,chi_eig,chi_evec,filename)

  DO ii=1,nchir
    DO iichi=1,nchir
      DO jjchi=1,nchir
        compr(jjchi,iichi)=chi_evec(jjchi,ii)*chi_evec(iichi,ii)
      ENDDO
    ENDDO
    compr_mat(:,:,ii)=compr
  ENDDO
    !Determine how many eigenvales to replace at each rho and theta point
    !filename='eignum_'//repname//'.txt'
   !OPEN(110,file=TRIM(outdir)//TRIM(filename))
  DO irho=1,nrho
    DO itheta=1,ntheta
      k=0
      DO ichi=1,nchir
        term=chi_eig(ichi)*2.d0*b(itheta)*rhom2(irho)
        IF (term.le.vcut) k=k+1
      ENDDO
      num_eig((irho-1)*ntheta+itheta)=k
      !write(110,*) (irho-1)*ntheta+itheta,irho,itheta, k
    ENDDO
 ENDDO
  !CLOSE(110)

    OPEN (unit=51,file=TRIM(BinOutdir)//'t_chi_clip.bin',form='unformatted')

  !DO itheta=1,ntheta

     DO irho=1,nrho ! rho_loop

       jrho=nrho-irho+1

       DO itheta=1,ntheta !theta loop

           IF (num_eig((jrho-1)*ntheta+itheta).lt.prev_num) THEN
             DO ii=num_eig((jrho-1)*ntheta+itheta)+1,prev_num !ii loop

               tempeig=tempeig+(compr_mat(:,:,ii)*chi_eig(ii))
               tempvcut=tempvcut+(compr_mat(:,:,ii)*vcut)

             ENDDO ! end ii loop

             t_chi_clip=t_chi_p+(tempvcut/(2.d0*b(itheta)*rhom2(jrho)))-tempeig

           ELSEIF (num_eig((jrho-1)*ntheta+itheta).eq.prev_num) THEN

             t_chi_clip=t_chi_p+(tempvcut/(2.d0*b(itheta)*rhom2(jrho)))-tempeig

           ENDIF

       If (num_eig((jrho-1)*ntheta+itheta).ne.nchir) write(51) t_chi_clip

       Call DGEMM('n','n',nchir,1,nchir,2.d0*b(itheta)*rhom2(jrho),t_chi_clip, &
                  nchir,phi3(:,jrho,itheta),nchir,0.d0,y3(:,jrho,itheta),nchir)

       prev_num=num_eig((jrho-1)*ntheta+itheta)

      ENDDO ! end theta loop

      prev_num=nchir
      tempeig=0.d0
      tempvcut=0.d0

    ENDDO ! end rho loop

    CLOSE(51)

  ELSE

    OPEN (unit=51,file=TRIM(BinOutdir)//'t_chi_clip.bin',form='unformatted')

    DO irho=1,nrho ! rho_loop

       t_chi_clip=t_chi_p

       jrho=nrho-irho+1

       DO itheta=1,ntheta !theta loop

         IF (num_eig((jrho-1)*ntheta+itheta).ne.nchir) read(51) t_chi_clip

       Call DGEMM('n','n',nchir,1,nchir,2.d0*b(itheta)*rhom2(jrho),t_chi_clip, &
                  nchir,phi3(:,jrho,itheta),nchir,0.d0,y3(:,jrho,itheta),nchir)

      ENDDO ! end theta loop

    ENDDO ! end rho loop

    CLOSE(51)

  ENDIF

RETURN
END SUBROUTINE tchi_apply