1!
2! Copyright (C) 2004 PWSCF group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!
9!--------------------------------------------------------------------------
10subroutine compute_chi_tm(lam,ik,ikk_in,phi_in,chi_out,xc,e)
11  !--------------------------------------------------------------------------
12  !
13  !     This routine computes the chi functions:
14  !          |chi> = (\epsilon -T -V_{loc)) |psi>
15  !
16  use kinds, only : DP
17  use radial_grids, only: ndmx
18  use ld1inc, only: grid, vpot, vpsloc
19
20  implicit none
21  integer :: &
22       ik,    & ! the point corresponding to rc
23       ikk_in,& ! the point after which the chi should be zero
24       lam      ! the angular momentum
25
26  real(DP) :: &
27       e,     &       ! input: the energy
28       xc(8),       & ! input: the parameters of the fit
29       phi_in(ndmx), & ! input: pseudo wavefunction
30       chi_out(ndmx)   ! output: the chi function
31  !
32  real(DP) :: &
33       dpoly
34
35  real(DP), external :: pr, d2pr, dpr
36
37  integer :: &
38       n
39  !
40  !   Troullier-Martins: use the analytic formula
41  !
42  do n=1,ik
43     dpoly = dpr(xc,xc(7),grid%r(n))
44     ! dpr =  first derivate of polynomial pr
45     ! d2pr= second derivate of polynomial pr
46     chi_out(n) = (e + (2*lam+2)/grid%r(n)*dpoly + &
47             d2pr(xc,xc(7),grid%r(n)) + dpoly**2 - vpsloc(n))*phi_in(n)
48  enddo
49  do n = ik+1,grid%mesh
50     chi_out(n) = (vpot(n,1) - vpsloc(n))*phi_in(n)
51  enddo
52  return
53end subroutine compute_chi_tm
54