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