Subroutine Clebsch_Gordan_Single(j1, j2, j3, m1, m2, C)
implicit none
integer*4, intent(in) :: j1, j2, j3, m1, m2
real*8, intent(out) :: C
integer*4 N, i
real*8 C_1, C_2
N=abs(j1-j2); if (N.lt.abs(m2)) N=abs(m2)
C_1=1.d00;  C_2=0.d00
Call Initial_Value(j1, j2, m1, m2, C_1)
If (j3.lt.N) C=0.d00
If (j3.eq.N) C=C_1
If (j3.gt.N) then ! Main Recursion
  do i=N+1, j3
    if (N.eq.0) then
	  Call Zero_Step(j1, i, m1, C_1, C_2, C)
	else
      Call Main_Recursion_Step(j1, j2, i, m1, m2, C_1, C_2, C)
	end if
    C_2=C_1; C_1=C
  end do
End if
!print *, C
End Subroutine Clebsch_Gordan_Single
!
Subroutine Initial_Value(j1, j2, m1, m2, C_)
implicit none
integer*4, intent(in) :: j1, j2, m1, m2
real*8, intent(out) :: C_
integer*4 i, n1, n2
C_=1.d00
n1=abs(j1-j2); n2=abs(m2)
If (n1.ge.n2) then
  if (j1.ge.j2) then
    call Products(2*j2, 2*n1+1, &
	                 n1+m2, j2-m2+m1, &
			          n1-m2, j2+m2-m1)
    C_=C_ *Sgn(j2, m1, m2)
  else
    call Products(2*j1, 2*n1+1, &
	                     n1+m2, j1-m1, &
						 n1-m2, j1+m1)
	C_=C_*Sgn(j1, m1, 0)
  end if
Else
  if (m2.ge.0) then
    call Products(2*n2+1, j1+j2-n2, &
	                     n2+j1-j2, j2-n2+m1, &
						 n2-j1+j2, j1-m1)
	 C_=C_*Sgn(j1, m1, 0)
  else
    call Products(2*n2+1, j1+j2-n2, &
	                     n2+j1-j2, j2-n2-m1, &
						 n2-j1+j2, j1+m1)
     C_=C_*Sgn(j2, m1, m2)
  end if
End if
Contains
!
Subroutine Products(p1, c1, p2, c2, p3, c3)
integer*4, intent(in) :: p1, p2, p3, c1, c2, c3
do i=1, p2
  C_=C_*(1.d00+1.d00*c2/i)
end do
do i=1, p1
  C_=C_*1.d00*i/(c1+1.d00*i)
end  do
do i=1, p3
  C_=C_*(1.d00+1.d00*c3/i)
end do
C_=dsqrt(C_)
End Subroutine Products
!
integer*4 Function Sgn(n1, n2, n3)
integer*4, intent(in) :: n1, n2, n3
i=n1+n2+n3-2*((n1+n2+n3)/2)
Sgn=-1; if (i.eq.0) Sgn=1
end Function Sgn
End Subroutine Initial_Value
!
Subroutine Main_Recursion_Step(j1, j2, j, m1, m2, C1, C2, C0)
implicit none
integer*4, intent(in) :: j1, j2, j, m1, m2
real*8, intent(in) :: C1, C2
real*8, intent(out) :: C0
real*8 g1, g2, g, n1, n2
g1=j1; g2=j2; g=j; n1=m1; n2=m2
C0=dsqrt(4.d00*g/(g+n2)*g/(g-n2) &
                  *(2*g-1)/(g1+g2+g+1)/(g1-g2+g) &
				  *(2*g+1)/(g2-g1+g)/(g1+g2-g+1)) &
                  *(   &
     ((2*n1-n2)*g*(g-1)-n2*g1*(g1+1)+n2*g2*(g2+1)) &
                                                           /2.d00/g/(g-1)*C1-   &
       dsqrt((g-n2-1)/(g-1)*(g+n2-1)/(g-1) &
              *(g2-g1+g-1)*(g1-g2+g-1)/(2*g-3) &
	          *(g1+g2-g+2)*(g2+g1+g)/(2*g-1)/4.d00)*C2 &
	    		    )
End Subroutine Main_Recursion_Step
!
Subroutine Zero_Step(j1, j3, m1, C1, C2, C0)
implicit none
integer*4, intent(in) :: j1, j3, m1
real*8, intent(in) :: C1, C2
real*8, intent(out) :: C0
real*8 g1, g3, n1
g1=j1; g3=j3; n1=m1
C0=dsqrt((2*g3+1)/g3*(2*g3-1)/g3*4.d00/(2*g1-g3+1)/(2*g1+g3+1)) &
      *(n1*C1-Mlt(j3)*C2) 
Contains
real*8 Function Mlt(j)
integer*4, intent(in) :: j
Mlt=0.d00
If (j.gt.1) Mlt=(g3-1)/2.d00*dsqrt((2*g1-g3+2)/(2*g3-3)*(2*g1+g3)/(2*j3-1))
end Function Mlt
End Subroutine Zero_Step
!
Subroutine A_Pair(nn, nn1, mm, pair)
Use Advertisement
implicit none
integer*4, intent(in) :: nn, nn1, mm
real*8, intent(out) :: pair(0:nn)
integer*4 st, t, min
real*8 C1, C2, C1_1, C1_2, C2_
min=abs(nn-nn1); if (min.eq.1) min=0
st=min; if (min.eq.0) st=1
Call Clebsch_Gordan_Single(nn, nn1, st, min, 1, C1) 
Call Clebsch_Gordan_Single(nn, nn1, st, min, min, C2)
pair(min)=C1*C2
C1_2=C1
st=min+1
Call Clebsch_Gordan_Single(nn, nn1, st, min, 1, C1) 
Call Clebsch_Gordan_Single(nn, nn1, st, min+1, min+1, C2)
pair(min+1)=C1*C2
C1_1=C1; C2_=C2
do t=min+2, nn
  st=t
  call Main_Recursion_Step(nn, nn1, st, mm, 1, C1_1, C1_2, C1)
  C1_2=C1_1; C1_1=C1
  call A_Recursion_Step
  C2_=C2
  pair(t)=C1*C2
end do
!
contains
Subroutine A_Recursion_Step
implicit none
real*8 nn_, t_, nn1_
nn_=nn; t_=t; nn1_=nn1
C2=-C2_* &
       dsqrt((nn_-t_+1.d00)/(nn_+nn1_-t_-1.d00)*(nn_+t_)/(nn1_-nn_+t_)* &
	            (2.d00*t_+1.d00)/(nn_+nn1_+t_+1.d00)*(2.d00*t_)/(nn_-nn1_+t_))
End Subroutine A_Recursion_Step
!
End Subroutine A_Pair
!