...EJB

src/nwpw/nwpwlib/utilities/paw_utilities/nwpw_gaunt.F

@@ -1,3 +1,4 @@
+c $Id: nwpw_gaunt.F 21176 2011-10-10 06:35:49Z d3y133 $
 
 *     ***********************************
 *     *                                 *
@@ -519,6 +520,62 @@ c      double precision theta_lm !*RESULT*
       return
       end 
 
+
+c!  *************************************************
+c!  
+c!     Name    : drtheta_lm
+c!  
+c!  
+c!     Purpose : calculates drtheta_lm for a scalar cos_theta
+c!               such that
+c!                                                              {cos(|m|*phi)   m>0
+c!         dT_lm(cos_theta,phi)/dtheta  = drtheta_lm(cos_theta)*{1              m==0
+c!                                                              {sin(|m|*phi)   m<0
+c!  
+c!  
+c!  *************************************************
+      double precision function drtheta_lm(l,m,cos_theta)
+      implicit none
+      integer l,m
+      double precision cos_theta
+
+      !*** local variables ***
+      integer i,mod_m
+      double precision coeff,twopi,fourpi,f
+
+      !*** external functions *** 
+      double precision rlegendre_lm
+      external         rlegendre_lm
+
+      twopi = 8.0d0*datan(1.0d0)
+
+      mod_m = abs(m)
+      if (mod_m.gt.l) 
+     >write(*,*) 'parameter out of order in function rtheta_lm'
+
+!     *** find coefficient ***
+      if (mod_m.eq.0) then 
+         coeff= 0.5d0
+      else if (mod_m.gt.0) then
+         coeff= 1.0d0 
+         do i=1,2*mod_m
+            coeff = coeff/dble(l-mod_m+i)
+         end do
+      endif
+      coeff = coeff*(2*l+1)/twopi
+      coeff = dsqrt(coeff)
+      if (mod_m.lt.l) then
+         f = coeff*(-mod_m*cos_theta*rlegendre_lm(l,mod_m,cos_theta)
+     >             + rlegendre_lm(l,mod_m+1,cos_theta))
+      else
+         f = coeff*(-mod_m*cos_theta*rlegendre_lm(l,mod_m,cos_theta))
+      end if
+      drtheta_lm = f
+      return
+      end 
+
+
+
 c!  *************************************************
 c!  
 c!     Name    : ytheta_lm
@@ -761,4 +818,3 @@ c!  *************************************************
       return
       end 
 
-c $Id: nwpw_gaunt.F 21176 2011-10-10 06:35:49Z d3y133 $