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 newd_at ( )
11  !-------------------------------------------------------------------------
12  !
13  !     this routine computes the new D coefficients
14  !
15  !
16  use kinds, only : dp
17  use radial_grids, only : ndmx
18  use ld1inc, only : ddd, bmat, nbeta, nspin, lls, jjs, ikk, qvan, vpstot, &
19                     grid, pseudotype, lpaw, which_augfun, qvanl
20  implicit none
21
22  integer :: &
23       ib,jb,n,is,nst
24
25  real(DP) :: &
26       int_0_inf_dr, &   ! the integral function
27       gi(ndmx)          ! the gi function
28
29  !
30  !    screening the D coefficients
31  !
32  if (pseudotype == 3) then
33     do ib=1,nbeta
34        do jb=1,ib
35           if (lls(ib).eq.lls(jb).and.abs(jjs(ib)-jjs(jb)).lt.1.0e-7_dp) then
36              nst=(lls(ib)+1)*2
37              do is=1,nspin
38                 IF (which_augfun=='PSQ') then
39                    do n=1,ikk(ib)
40                       gi(n)=qvanl(n,ib,jb,0)*vpstot(n,is)
41                    enddo
42                 ELSE
43                    do n=1,ikk(ib)
44                       gi(n)=qvan(n,ib,jb)*vpstot(n,is)
45                    enddo
46                 ENDIF
47                 ddd(ib,jb,is)= bmat(ib,jb) &
48                      + int_0_inf_dr(gi,grid,ikk(ib),nst)
49                 ddd(jb,ib,is)=ddd(ib,jb,is)
50              enddo
51           endif
52        enddo
53     enddo
54  else if (pseudotype == 2) then
55     !
56     !    non-US separable PP case: just copy unscreened D coeffs
57     !
58     do is=1,nspin
59        ddd(:,:,is)= bmat(:,:)
60     enddo
61  endif
62
63  return
64end subroutine newd_at
65