Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
f2cl
f2cl
Commits
43a68f6f
Commit
43a68f6f
authored
Nov 25, 2011
by
Raymond Toy
Browse files
Export all of the BLAS functions so LAPACK can use them without a packag
prefix.
parent
e97cd145
Changes
4
Hide whitespace changes
Inline
Side-by-side
packages/blas/blas-package.lisp
View file @
43a68f6f
(
defpackage
"BLAS"
(
:use
"COMMON-LISP"
)
(
:export
"DAXPY"
"DCOPY"
"DDOT"
"DNRM2"
"DSCAL"
"IDAMAX"
"DASUM"
"DCABS1"
"DGBMV"
"DGEMM"
"DGEMV"
"DGER"
"DROT"
"DROTG"
"DSBMV"
"DSPMV"
"DSPR"
"DSPR2"
"DSWAP"
"DSYMM"
"DSYMV"
"DSYR"
"DSYR2"
"DSYR2K"
"DSYRK"
"DTBMV"
"DTBSV"
"DTPMV"
"DTPSV"
"DTRMM"
"DTRMV"
"DTRSM"
"DTRSV"
"DZASUM"
"DZNRM2"
"ICAMAX"
"ISAMAX"
"IZAMAX"
"LSAME"
"XERBLA"
))
\ No newline at end of file
(
:export
;; blas hompack
"DAXPY"
"DCOPY"
"DDOT"
"DNRM2"
"DSCAL"
"IDAMAX"
;; blas real
"DASUM"
"DCABS1"
"DGBMV"
"DGEMM"
"DGEMV"
"DGER"
"DROT"
"DROTG"
"DSBMV"
"DSPMV"
"DSPR"
"DSPR2"
"DSWAP"
"DSYMM"
"DSYMV"
"DSYR"
"DSYR2"
"DSYR2K"
"DSYRK"
"DTBMV"
"DTBSV"
"DTPMV"
"DTPSV"
"DTRMM"
"DTRMV"
"DTRSM"
"DTRSV"
"DZASUM"
"DZNRM2"
"ICAMAX"
"ISAMAX"
"IZAMAX"
"LSAME"
"XERBLA"
;; blas complex
"ZAXPY"
"ZCOPY"
"ZDOTC"
"ZDOTU"
"ZDSCAL"
"ZGBMV"
"ZGEMM"
"ZGEMV"
"ZGERC"
"ZGERU"
"ZHBMV"
"ZHEMM"
"ZHEMV"
"ZHER"
"ZHER2"
"ZHER2K"
"ZHERK"
"ZHPMV"
"ZHPR"
"ZHPR2"
"ZROTG"
"ZSCAL"
"ZSWAP"
"ZSYMM"
"ZSYR2K"
"ZSYRK"
"ZTBMV"
"ZTBSV"
"ZTPMV"
"ZTPSV"
"ZTRMM"
"ZTRMV"
"ZTRSM"
"ZTRSV"
))
packages/lapack.asd
View file @
43a68f6f
...
...
@@ -250,7 +250,9 @@
:depends-on
(
"zladiv"
))
(
:file
"zungqr"
:depends-on
(
"zung2r"
"zlarft"
"zlarfb"
))
(
:file
"disnan"
)
(
:file
"disnan"
:depends-on
(
"dlaisnan"
))
(
:file
"dlaisnan"
)
(
:file
"zlassq"
)
(
:file
"zladiv"
)
(
:file
"zung2r"
...
...
@@ -279,15 +281,20 @@
:depends-on
(
"dlapy3"
))
(
:file
"zlahqr"
:depends-on
(
"zlarfg"
))
(
:file
"zgehrd"
)
(
:file
"zgehrd"
:depends-on
(
"zlahr2"
"zgehd2"
))
(
:file
"zunmhr"
:depends-on
(
"zunmqr"
))
(
:file
"ztrexc"
:depends-on
(
"zlartg"
"zrot"
))
:depends-on
(
"zlartg"
"zrot"
"zunm2r"
))
(
:file
"dlapy3"
)
(
:file
"zlartg"
)
(
:file
"zrot"
)
(
:file
"zunmqr"
)
(
:file
"zlahr2"
)
(
:file
"zgehd2"
:depends-on
(
"zlarfg"
"zlarf"
))
(
:file
"zunm2r"
)
))))
(
defsystem
"lapack-package"
...
...
packages/lapack/lapack-tests.lisp
View file @
43a68f6f
...
...
@@ -503,6 +503,70 @@
(
format
t
"Optimum workspace required = ~D~%"
(
truncate
(
aref
work
0
)))
(
format
t
"Workspace provided = ~D~%"
lwork
))))
(
defun
make-complex-eigvec
(
n
vr
)
(
make-array
(
list
n
n
)
:displaced-to
vr
:element-type
(
array-element-type
vr
)))
(
defun
print-zgeev-results
(
e-val
e-vec
)
(
format
t
"~2%ZGEEV Example Program Results~%"
)
(
let
((
n
(
length
e-val
)))
(
dotimes
(
k
n
)
(
format
t
"Eigenvalue(~D) = ~A~%"
k
(
aref
e-val
k
))
(
format
t
"~%Eigenvector(~D)~%"
k
)
(
dotimes
(
row
n
)
(
format
t
"~A~%"
(
aref
e-vec
row
k
)))
(
terpri
))))
(
defun
test-zgeev
()
;; The matrix is
;;
;; #c(-3.97, -5.04) #c(-4.11, 3.70) #c(-0.34, 1.01) #c( 1.29, -0.86)
;; #c( 0.34, -1.50) #c( 1.52, -0.43) #c( 1.88, -5.38) #c( 3.36, 0.65)
;; #c( 3.31, -3.85) #c( 2.50, 3.45) #c( 0.88, -1.08) #c( 0.64, -1.48)
;; #c(-1.10, 0.82) #c( 1.81, -1.59) #c( 3.25, 1.33) #c( 1.57, -3.44)
;;
;; Recall that Fortran arrays are column-major order!
(
let*
((
n
4
)
(
a-mat
(
make-array
(
*
n
n
)
:element-type
'
(
complex
double-float
)
:initial-contents
'
(
#c
(
-3.97d0
-5.04d0
)
#c
(
0.34d0
-1.50d0
)
#c
(
3.31d0
-3.85d0
)
#c
(
-1.10d0
0.82d0
)
#c
(
-4.11d0
3.70d0
)
#c
(
1.52d0
-0.43d0
)
#c
(
2.50d0
3.45d0
)
#c
(
1.81d0
-1.59d0
)
#c
(
-0.34d0
1.01d0
)
#c
(
1.88d0
-5.38d0
)
#c
(
0.88d0
-1.08d0
)
#c
(
3.25d0
1.33d0
)
#c
(
1.29d0
-0.86d0
)
#c
(
3.36d0
0.65d0
)
#c
(
0.64d0
-1.48d0
)
#c
(
1.57d0
-3.44d0
))))
(
lwork
660
)
(
w
(
make-array
n
:element-type
'
(
complex
double-float
)))
(
rw
(
make-array
lwork
:element-type
'double-float
))
(
vl
(
make-array
0
:element-type
'
(
complex
double-float
)))
(
vr
(
make-array
(
*
n
n
)
:element-type
'
(
complex
double-float
)))
(
work
(
make-array
lwork
:element-type
'
(
complex
double-float
))))
(
multiple-value-bind
(
z-jobvl
z-jobvr
z-n
z-a
z-lda
z-w
z-vl
z-ldvl
z-vr
z-ldvr
z-work
z-lwork
z-rwork
info
)
(
zgeev
"N"
"V"
n
a-mat
n
w
vl
n
vr
n
work
lwork
rw
0
)
(
declare
(
ignore
z-jobvl
z-jobvr
z-n
z-a
z-lda
z-w
z-vl
z-ldvl
z-vr
z-ldvr
z-work
z-lwork
z-rwork
))
;; Display solution
(
cond
((
zerop
info
)
(
print-zgeev-results
w
(
make-complex-eigvec
n
vr
)))
(
t
(
format
t
"Failure in DGEEV. INFO = ~D~%"
info
)))
;; Display workspace info
(
format
t
"Optimum workspace required = ~D~%"
(
truncate
(
realpart
(
aref
work
0
))))
(
format
t
"Workspace provided = ~D~%"
lwork
))))
(
defun
do-all-lapack-tests
()
(
test-dgeev
)
(
test-dgeevx
)
...
...
src/macros.l
View file @
43a68f6f
...
...
@@ -6,7 +6,7 @@
(in-package :f2cl-lib)
(defparameter *f2cl-macros-version*
"$Id: macros.l,v
c4abe8cf9a
f0 2011/11/2
4
0
7:12:32
toy $")
"$Id: macros.l,v
fceac530e
f0
c
2011/11/2
6
0
4:02:26
toy $")
(eval-when
#+gcl (compile load eval)
...
...
@@ -384,7 +384,17 @@ is not included")
(double-float
(truncate (the (double-float #.(float most-negative-fixnum 1d0)
#.(float most-positive-fixnum 1d0))
x)))))
x)))
((complex single-float)
(the integer4
(truncate (the (single-float #.(float (- (ash 1 31)))
#.(float (1- (ash 1 31))))
(realpart x)))))
((complex double-float)
(the integer4
(truncate (the (double-float #.(float (- (ash 1 31)) 1d0)
#.(float (1- (ash 1 31)) 1d0))
(realpart x)))))))
#+(or cmu scl)
(defun int (x)
...
...
@@ -404,7 +414,17 @@ is not included")
(the integer4
(truncate (the (double-float #.(float (- (ash 1 31)) 1d0)
#.(float (1- (ash 1 31)) 1d0))
x))))))
x))))
((complex single-float)
(the integer4
(truncate (the (single-float #.(float (- (ash 1 31)))
#.(float (1- (ash 1 31))))
(realpart x)))))
((complex double-float)
(the integer4
(truncate (the (double-float #.(float (- (ash 1 31)) 1d0)
#.(float (1- (ash 1 31)) 1d0))
(realpart x)))))))
(defun ifix (x)
...
...
@@ -1530,7 +1550,7 @@ causing all pending operations to be flushed"
;;;-------------------------------------------------------------------------
;;; end of macros.l
;;;
;;; $Id: macros.l,v
c4abe8cf9a
f0 2011/11/2
4
0
7:12:32
toy $
;;; $Id: macros.l,v
fceac530e
f0
c
2011/11/2
6
0
4:02:26
toy $
;;; $Log$
;;; Revision 1.117 2011/02/28 22:21:07 rtoy
;;; When opening an old file, we should set :if-exists to :overwrite to
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment