[lisplab-cvs] r16 - in src: core specfunc

[Jørn Inge Vestgården]

Author: jivestgarden
Date: Wed May  6 15:02:17 2009
New Revision: 16

Log:
started adding special functions. Not complete

Added:
   src/specfunc/
   src/specfunc/level0-specfunc.lisp
Modified:
   src/core/level0-interface.lisp

Modified: src/core/level0-interface.lisp
==============================================================================
--- src/core/level0-interface.lisp	(original)
+++ src/core/level0-interface.lisp	Wed May  6 15:02:17 2009
@@ -92,3 +92,21 @@
 
 (defgeneric .expt! (a b))
 
+(defgeneric .Ai (x))
+
+(defgeneric .besj (n x))
+
+(defgeneric .besy (n x))
+
+(defgeneric .besi (n x))
+
+(defgeneric .besk (n x))
+
+(defgeneric .besh (n x))
+
+(defgeneric .erf (x)) 
+
+(defgeneric .erfc (x)) 
+
+(defgeneric .gamma (x)) 
+

Added: src/specfunc/level0-specfunc.lisp
==============================================================================
--- (empty file)
+++ src/specfunc/level0-specfunc.lisp	Wed May  6 15:02:17 2009
@@ -0,0 +1,92 @@
+;;; Lisplab, level0-specunc.lisp
+;;; Special functions for numeric arguments. Using Slatec.
+;;; 
+
+;;; Copyright (C) 2009 Joern Inge Vestgaarden
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License along
+;;; with this program; if not, write to the Free Software Foundation, Inc.,
+;;; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+(in-package :lisplab)
+
+(defun to-df (x)
+  (coerce x 'double-float))
+
+(defun dvec (n)
+  (make-array n :element-type 'double-float))
+
+(defmethod .besj (n (x number))
+  ;; 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 (dvec 1))
+		   (cy (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 (dvec 1)))
+		(slatec:dbesj x (to-df n) 1 y 0)
+		(aref y 0))))))))
+
+(defmethod .besy (n (x number))
+  ;; Bessel Y function (Neumann function), for n >=0, x>0, real and complex numbers. 
+  ;; TODO: what about negaive n, negative x and complex n?
+   (typecase x 
+    (complex (let ((rx (to-df (realpart x)))
+		   (cx (to-df (imagpart x)))
+		   (ry (dvec 1))
+		   (cy (dvec 1))
+		   (rw (dvec 1))
+		   (cw (dvec 1)))
+	       (slatec:zbesy rx cx (to-df n) 1 1 ry cy 0 rw cw 0)
+	       (complex (aref ry 0) (aref cy 0))))
+    (t (let ((x (to-df x)))
+	 (case n 
+	   (0 (slatec:dbesy0 x))
+	   (1 (slatec:dbesy1 x))
+	   (t (let ((y (dvec 1)))
+		(slatec:dbesy x (to-df n) 1 y)
+		(aref y 0))))))))
+  
+
+
+
+
+#|
+
+
+(defgeneric .besy (n x))
+
+(defgeneric .besi (n x))
+
+(defgeneric .besk (n x))
+
+(defgeneric .besh (n x))
+
+(defgeneric .erf (x)) 
+
+(defgeneric .erfc (x)) 
+
+(defgeneric .gamma (x)) 
+
+(defmethod .Ai (x) 
+  (slatec:dai x))
+
+
+|#
\ No newline at end of file