[lisplab-cvs] r196 - trunk/src/specfunc

Jørn Inge Vestgården jivestgarden at common-lisp.net
Thu Nov 25 20:33:07 UTC 2010


Author: jivestgarden
Date: Thu Nov 25 15:33:07 2010
New Revision: 196

Log:
besj fix from Dan Becker

Modified:
   trunk/src/specfunc/level0-specfunc.lisp

Modified: trunk/src/specfunc/level0-specfunc.lisp
==============================================================================
--- trunk/src/specfunc/level0-specfunc.lisp	(original)
+++ trunk/src/specfunc/level0-specfunc.lisp	Thu Nov 25 15:33:07 2010
@@ -20,24 +20,29 @@
 
 (in-package :lisplab)
 
+(defun neg-integer-p (x)
+  (and (< x 0) (= x (truncate x))))
+
 (defmethod .besj (n (x number))
   "f2cl slatec based implementation"
   ;; Bessel J function, for n >=0, real and complex numbers. 
   ;; TODO: what about negaive n and complex n?
-  (typecase x 
-    (complex (let ((rx (to-df (realpart x)))
-		   (cx (to-df (imagpart x)))
-		   (ry (make-dvec 1))
-		   (cy (make-dvec 1)))
-	       (slatec:zbesj rx cx (to-df n) 1 1 ry cy 0 0)
-	       (complex (aref ry 0) (aref cy 0))))
-    (t (let ((x (to-df x)))
-	 (case n 
-	   (0 (slatec:dbesj0 x))
-	   (1 (slatec:dbesj1 x))
-	   (t (let ((y (make-dvec 1)))
-		(slatec:dbesj x (to-df n) 1 y 0)
-		(aref y 0))))))))
+  (if (neg-integer-p n)
+      (* (expt -1 n) (.besj (- n) x))
+      (typecase x 
+	(complex (let ((rx (to-df (realpart x)))
+		       (cx (to-df (imagpart x)))
+		       (ry (make-dvec 1))
+		       (cy (make-dvec 1)))
+		   (slatec:zbesj rx cx (to-df n) 1 1 ry cy 0 0)
+		   (complex (aref ry 0) (aref cy 0))))
+	(t (let ((x (to-df x)))
+	     (case n 
+	       (0 (slatec:dbesj0 x))
+	       (1 (slatec:dbesj1 x))
+	       (t (let ((y (make-dvec 1)))
+		    (slatec:dbesj x (to-df n) 1 y 0)
+		    (aref y 0)))))))))
 
 (defmethod .besy (n (x number))
   "f2cl slatec based implementation"




More information about the lisplab-cvs mailing list