1
2! Copyright (C) 2008 F. Bultmark, F. Cricchio and L. Nordstrom.
3! This file is distributed under the terms of the GNU General Public License.
4! See the file COPYING for license details.
5
6!BOP
7! !ROUTINE: pottm2
8! !INTERFACE:
9subroutine pottm2(i,k1,p,vh,vx)
10! !USES:
11use moddftu
12! !INPUT/OUTPUT PARAMETERS:
13!   i  : DFT+U entry (in,integer)
14!   k1 : k-index of tensor moment (in,integer)
15!   p  : p-index of tensor moment  (in,integer)
16!   vh : Hartree potential energy (out,real)
17!   vx : exchange potential energy (out,real)
18! !DESCRIPTION:
19!   Calculates the DFT+$U$ Hartree and exchange potential energies for a 2-index
20!   tensor moment component. See {\tt pottm3}.
21!
22! !REVISION HISTORY:
23!   Created April 2008 (F. Cricchio and L. Nordstrom)
24!   Modified, January 2014 (JKD)
25!EOP
26!BOC
27implicit none
28integer, intent(in) :: i
29integer, intent(in) :: k1,p
30real(8), intent(out) :: vh,vx
31! local variables
32integer l,k
33real(8) nlk,t1,t2
34! external functions
35real(8), external :: wigner3j,wigner6j,factnm
36l=idftu(2,i)
37nlk=factnm(2*l,1)/sqrt(factnm(2*l-k1,1)*factnm(2*l+k1+1,1))
38vh=0.d0
39vx=0.d0
40do k=0,2*l,2
41  t1=0.5d0*(dble(2*l+1)*nlk*wigner3j(l,k,l,0,0,0))**2
42  t2=0.5d0*dble((2*k1+1)*(-1)**k1)*wigner6j(l,l,k1,l,l,k)
43  if (k.eq.k1) then
44    if (p.eq.0) vh=t1*fdu(k1,i)
45  end if
46  vx=vx-t1*t2*fdu(k,i)
47end do
48end subroutine
49!EOC
50
51