Commit 2178daec authored by liam's avatar liam

Port more of blas1, add single float vector methods. New function

#'float-to-cl.


git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3101 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
parent b8b9100e
......@@ -3,7 +3,7 @@
; description: Common structures defined by GSL.
; date: Sun May 28 2006 - 22:04
; author: Liam M. Healy
; modified: Tue Jun 13 2006 - 21:45
; modified: Mon Jun 26 2006 - 21:38
;********************************************************
;;; $Id: $
......@@ -66,6 +66,9 @@ and a scaling exponent e10, such that the value is val*10^e10."
;;;; Built-in numerical types
;;;;****************************************************************************
(defun float-to-cl (float &optional (index 0))
(cffi:mem-aref float :float index))
(defun double-to-cl (double &optional (index 0))
(cffi:mem-aref double :double index))
......@@ -77,6 +80,7 @@ and a scaling exponent e10, such that the value is val*10^e10."
(defun cl-convert-function (type)
(case type
(:float 'float-to-cl)
(:double 'double-to-cl)
(:size 'size-to-cl)
(:int 'int-to-cl)
......
......@@ -3,7 +3,7 @@
; description: BLAS level 1, Vector operations
; date: Wed Apr 26 2006 - 15:23
; author: Liam Healy
; modified: Thu Jun 22 2006 - 23:07
; modified: Mon Jun 26 2006 - 22:22
;********************************************************
;;; $Id: $
......@@ -12,13 +12,15 @@
;;; Currently only includes double-float vector routines.
;;; Not ported: routines that use raw vectors gsl_blas_drotg, gsl_blas_drotmg, gsl_blas_drotm
;;; Doesn't work: swap, copy
;;;;****************************************************************************
;;;; Generic
;;;;****************************************************************************
(export '(dot norm asum imax swap copy axpy scal rot))
(defgeneric dot (result vector1 vector2)
(defgeneric dot (vector1 vector2)
(:documentation "Dot, or inner, product between vectors."))
(defgeneric norm (x)
......@@ -61,17 +63,34 @@
((gsl-array result) :pointer))
:invalidate (result))
(defun-gsl dot ((vec1 gsl-vector-single) (vec2 gsl-vector-single))
"gsl_blas_sdot"
(((pointer vec1) :pointer) ((pointer vec2) :pointer) (result :float))
:type :method)
(defun-gsl norm ((vec gsl-vector-single))
"gsl_blas_snrm2" (((pointer vec) :pointer))
:type :method
:c-return :float)
(defun-gsl asum ((vec gsl-vector-single))
"gsl_blas_sasum" (((pointer vec) :pointer))
:type :method
:c-return :float)
(defun-gsl imax ((vec gsl-vector-single))
"gsl_blas_isamax" (((pointer vec) :pointer))
:type :method
:c-return :int)
;;;;****************************************************************************
;;;; Double
;;;;****************************************************************************
(defun-gsl dot
((vec1 gsl-vector-double) (vec2 gsl-vector-double) (result gsl-vector-double))
(defun-gsl dot ((vec1 gsl-vector-double) (vec2 gsl-vector-double))
"gsl_blas_ddot"
(((pointer vec1) :pointer) ((pointer vec2) :pointer)
((gsl-array result) :pointer))
:type :method
:invalidate (result))
(((pointer vec1) :pointer) ((pointer vec2) :pointer) (result :double))
:type :method)
(defun-gsl norm ((vec gsl-vector-double))
"gsl_blas_dnrm2" (((pointer vec) :pointer))
......@@ -123,14 +142,49 @@
;;;;****************************************************************************
(lisp-unit:define-test blas1
(lisp-unit:fp-equal
#(3.0d0 8.0d0 15.0d0)
;; single
(lisp-unit:assert-first-fp-equal
"0.260000000000e+02"
(with-data (a vector-single 3)
(with-data (b vector-single 3)
(setf (data a) #(1.0f0 2.0f0 3.0f0)
(data b) #(3.0f0 4.0f0 5.0f0))
(dot a b))))
(lisp-unit:assert-first-fp-equal
"0.707106770000e+01"
(with-data (b vector-single 3)
(setf (data b) #(3.0 4.0 5.0))
(norm b)))
(lisp-unit:assert-first-fp-equal
"0.120000000000e+02"
(with-data (b vector-single 3)
(setf (data b) #(3.0 4.0 5.0))
(asum b)))
(lisp-unit:assert-eql
1
(with-data (b vector-single 3)
(setf (data b) #(3.0f0 5.0f0 4.0f0))
(imax b)))
;; double
(lisp-unit:assert-first-fp-equal
"0.260000000000d+02"
(with-data (a vector-double 3)
(with-data (b vector-double 3)
(with-data (c vector-double 3)
(setf (data a) #(1.0d0 2.0d0 3.0d0)
(data b) #(3.0d0 4.0d0 5.0d0))
(dot a b c)
(data c))))
)
)
(setf (data a) #(1.0d0 2.0d0 3.0d0)
(data b) #(3.0d0 4.0d0 5.0d0))
(dot a b))))
(lisp-unit:assert-first-fp-equal
"0.707106781187d+01"
(with-data (b vector-double 3)
(setf (data b) #(3.0d0 4.0d0 5.0d0))
(norm b)))
(lisp-unit:assert-first-fp-equal
"0.120000000000d+02"
(with-data (b vector-double 3)
(setf (data b) #(3.0d0 4.0d0 5.0d0))
(asum b)))
(lisp-unit:assert-eql
1
(with-data (b vector-double 3)
(setf (data b) #(3.0d0 5.0d0 4.0d0))
(imax b))))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment