1C$Id$ 2************************************************************************ 3* * 4 subroutine ecp_c2srecur (l,Xp,Xo,Xm,ncp,nco,ncm) 5* * 6* Perform recursion to generate transformation coefficients from * 7* cartesian monomials to unnormalized solid spherical harmonics * 8* * 9* l (inp) - angular momentum of current set. Set to be generated * 10* has angular momentum l+1 * 11* Xp (out) - X_(l+1)^m, set of u.s.s.h. to be generated. * 12* Xo (inp) - X_l^m, current set of u.s.s.h. * 13* Xp (inp) - X_(l-1)^m, previous set of u.s.s.h. * 14* ncp (inp) - number of cartesians for l+1 set, (l+2)*(l+3)/2 * 15* nco (inp) - number of cartesians for l set, (l+1)*(l+2)/2 * 16* ncm (inp) - number of cartesians for l-1 set, l*(l+1)/2 * 17* * 18* Written by K. G. Dyall * 19* * 20************************************************************************ 21 implicit none 22 integer i,j,k,l,m,m1,x,y,z,ncp,nco,ncm 23 double precision wa,wb 24 double precision Xp(ncp,-l-1:l+1),Xo(nco,-l:l),Xm(ncm,-l+1:l-1) 25* 26 do m = 1,l 27 m1 = m+1 28 wa = l+m+1 29 x = 0 30 do i = l,0,-1 31 k = l-i 32 do j = k,0,-1 33 x = x+1 34 y = x+k+1 35 z = y+1 36 Xp(x,m1) = Xp(x,m1)+wa*Xo(x,m) 37 Xp(x,-m1) = Xp(x,-m1)+wa*Xo(x,-m) 38 Xp(y,m1) = Xp(y,m1)-wa*Xo(x,-m) 39 Xp(y,-m1) = Xp(y,-m1)+wa*Xo(x,m) 40 Xp(z,m) = Xp(z,m)+Xo(x,m) 41 Xp(z,-m) = Xp(z,-m)+Xo(x,-m) 42 end do 43 end do 44 end do 45 wa = l+1 46 wb = 2*l+1 47 wb = wb/wa 48 x = 0 49 do i = l,0,-1 50 k = l-i 51 do j = k,0,-1 52 x = x+1 53 y = x+k+1 54 z = y+1 55 Xp(x,1) = Xp(x,1)+wa*Xo(x,0) 56 Xp(y,-1) = Xp(y,-1)+wa*Xo(x,0) 57 Xp(z,0) = Xp(z,0)+wb*Xo(x,0) 58 end do 59 end do 60 wb = -l 61 wb = wb/wa 62 x = 0 63 do i = l-1,0,-1 64 k = l-i 65 do j = k-1,0,-1 66 x = x+1 67 y = x+2*k+1 68 z = y+2 69 Xp(x,0) = Xp(x,0)+wb*Xm(x,0) 70 Xp(y,0) = Xp(y,0)+wb*Xm(x,0) 71 Xp(z,0) = Xp(z,0)+wb*Xm(x,0) 72 end do 73 end do 74* 75 return 76 end 77