The Elk Code
wigner3jf.f90
Go to the documentation of this file.
1 
2 ! Copyright (C) 2014 J. K. Dewhurst, S. Sharma and E. K. U. Gross.
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: wigner3jf
8 ! !INTERFACE:
9 real(8) function wigner3jf(j12,j22,j32,m12,m22,m32)
10 ! !INPUT/OUTPUT PARAMETERS:
11 ! j12, j22, j32 : angular momentum quantum numbers times 2 (in,integer)
12 ! m12, m22, m32 : magnetic quantum numbers times 2 (in,integer)
13 ! !DESCRIPTION:
14 ! Returns the Wigner $3j$-symbol for the case where the arguments may be
15 ! fractional, i.e. multiples of $\frac{1}{2}$. The input parameters to this
16 ! function are taken to be twice their actual values, which allows them to
17 ! remain integers. The formula used is identical to that in {\tt wigner3j}.
18 !
19 ! !REVISION HISTORY:
20 ! Created January 2014 (JKD)
21 !EOP
22 !BOC
23 implicit none
24 ! arguments
25 integer, intent(in) :: j12,j22,j32
26 integer, intent(in) :: m12,m22,m32
27 ! local variables
28 integer jm1,jm2,jm3,n1,n2
29 integer l12,l22,l32,l42
30 integer k,k1,k2,l1,l2,l3
31 real(8) sgn,sm,t1
32 ! external functions
33 real(8), external :: factn,factr
34 ! check input variables
35 if ((j12 < 0).or.(j22 < 0).or.(j32 < 0).or.(abs(m12) > j12).or. &
36  (abs(m22) > j22).or.(abs(m32) > j32)) then
37  write(*,*)
38  write(*,'("Error(wigner3jf): invalid arguments :")')
39  write(*,'("j12 = ",I8," j22 = ",I8," j32 = ",I8)') j12,j22,j32
40  write(*,'("m12 = ",I8," m22 = ",I8," m32 = ",I8)') m12,m22,m32
41  write(*,*)
42  stop
43 end if
44 if ((j12 == 0).and.(j22 == 0).and.(j32 == 0)) then
45  wigner3jf=1.d0
46  return
47 end if
48 if ((j12 > 100).or.(j22 > 100).or.(j32 > 100)) then
49  write(*,*)
50  write(*,'("Error(wigner3jf): angular momenta out of range : ",3I8)') j12, &
51  j22,j32
52  write(*,*)
53  stop
54 end if
55 jm1=j12+m12
56 jm2=j22+m22
57 jm3=j32+m32
58 if ((mod(jm1,2) /= 0).or.(mod(jm2,2) /= 0).or.(mod(jm3,2) /= 0)) then
59  wigner3jf=0.d0
60  return
61 end if
62 l12=j22-j12+j32
63 l22=j12-j22+j32
64 l32=j12+j22-j32
65 l42=j12+j22+j32
66 if ((mod(l12,2) /= 0).or.(mod(l22,2) /= 0).or.(mod(l32,2) /= 0).or. &
67  (mod(l42,2) /= 0)) then
68  wigner3jf=0.d0
69  return
70 end if
71 l1=l12/2
72 l2=l22/2
73 l3=l32/2
74 if ((m12+m22+m32 /= 0).or.(l1 < 0).or.(l2 < 0).or.(l3 < 0)) then
75  wigner3jf=0.d0
76  return
77 end if
78 n1=(j12-m12)/2
79 n2=(j22+m22)/2
80 k1=max(0,n1-l2,n2-l1)
81 k2=min(l3,n1,n2)
82 k=k1+(j22-j12+m32)/2
83 if (mod(k,2) /= 0) then
84  sgn=-1.d0
85 else
86  sgn=1.d0
87 end if
88 sm=0.d0
89 do k=k1,k2
90  t1=sgn*factr(l1,l1-n2+k)*factr(l2,l2-n1+k)*factr(l3,l3-k)
91  sm=sm+t1/(factn(k)*factn(n1-k)*factn(n2-k))
92  sgn=-sgn
93 end do
94 jm1=jm1/2
95 jm2=jm2/2
96 jm3=jm3/2
97 t1=factr(jm1,l1)*factr(jm2,l2)*factr(jm3,l3)
98 jm1=(j12-m12)/2
99 jm2=(j22-m22)/2
100 jm3=(j32-m32)/2
101 t1=t1*factr(jm3,1+l42/2)*factn(jm1)*factn(jm2)
102 wigner3jf=sm*sqrt(t1)
103 end function
104 !EOC
105 
real(8) function wigner3jf(j12, j22, j32, m12, m22, m32)
Definition: wigner3jf.f90:10
elemental real(8) function factn(n)
Definition: factn.f90:7
real(8) function factr(n, d)
Definition: factr.f90:10