summaryrefslogtreecommitdiff
path: root/lib/Numeric/LinearAlgebra/LAPACK.hs
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2007-11-22 17:03:41 +0000
committerAlberto Ruiz <aruiz@um.es>2007-11-22 17:03:41 +0000
commit01a14ad32e0fd8586498ead61a426f20b724652b (patch)
treeb894c4d09700c2cf1f6abf2c89e6df81eebddb71 /lib/Numeric/LinearAlgebra/LAPACK.hs
parent2f45fdd97f80c0ffd0e10cce68d1cd24a43696c0 (diff)
app1, app2, ...
Diffstat (limited to 'lib/Numeric/LinearAlgebra/LAPACK.hs')
-rw-r--r--lib/Numeric/LinearAlgebra/LAPACK.hs33
1 files changed, 11 insertions, 22 deletions
diff --git a/lib/Numeric/LinearAlgebra/LAPACK.hs b/lib/Numeric/LinearAlgebra/LAPACK.hs
index 19516e3..936cb19 100644
--- a/lib/Numeric/LinearAlgebra/LAPACK.hs
+++ b/lib/Numeric/LinearAlgebra/LAPACK.hs
@@ -61,8 +61,7 @@ svdAux f st x = unsafePerformIO $ do
61 u <- createMatrix ColumnMajor r r 61 u <- createMatrix ColumnMajor r r
62 s <- createVector (min r c) 62 s <- createVector (min r c)
63 v <- createMatrix ColumnMajor c c 63 v <- createMatrix ColumnMajor c c
64 ww4 withMatrix x withMatrix u withVector s withMatrix v $ \x u s v -> 64 app4 f mat x mat u vec s mat v st
65 f // x // u // s // v // check st
66 return (u,s,trans v) 65 return (u,s,trans v)
67 where r = rows x 66 where r = rows x
68 c = cols x 67 c = cols x
@@ -74,8 +73,7 @@ eigAux f st m
74 l <- createVector r 73 l <- createVector r
75 v <- createMatrix ColumnMajor r r 74 v <- createMatrix ColumnMajor r r
76 dummy <- createMatrix ColumnMajor 1 1 75 dummy <- createMatrix ColumnMajor 1 1
77 ww4 withMatrix m withMatrix dummy withVector l withMatrix v $ \m dummy l v -> 76 app4 f mat m mat dummy vec l mat v st
78 f // m // dummy // l // v // check st
79 return (l,v) 77 return (l,v)
80 where r = rows m 78 where r = rows m
81 79
@@ -117,8 +115,7 @@ eigRaux m
117 l <- createVector r 115 l <- createVector r
118 v <- createMatrix ColumnMajor r r 116 v <- createMatrix ColumnMajor r r
119 dummy <- createMatrix ColumnMajor 1 1 117 dummy <- createMatrix ColumnMajor 1 1
120 ww4 withMatrix m withMatrix dummy withVector l withMatrix v $ \m dummy l v -> 118 app4 dgeev mat m mat dummy vec l mat v "eigR"
121 dgeev // m // dummy // l // v // check "eigR"
122 return (l,v) 119 return (l,v)
123 where r = rows m 120 where r = rows m
124 121
@@ -147,8 +144,7 @@ eigS' m
147 | otherwise = unsafePerformIO $ do 144 | otherwise = unsafePerformIO $ do
148 l <- createVector r 145 l <- createVector r
149 v <- createMatrix ColumnMajor r r 146 v <- createMatrix ColumnMajor r r
150 ww3 withMatrix m withVector l withMatrix v $ \m l v -> 147 app3 dsyev mat m vec l mat v "eigS"
151 dsyev // m // l // v // check "eigS"
152 return (l,v) 148 return (l,v)
153 where r = rows m 149 where r = rows m
154 150
@@ -170,8 +166,7 @@ eigH' m
170 | otherwise = unsafePerformIO $ do 166 | otherwise = unsafePerformIO $ do
171 l <- createVector r 167 l <- createVector r
172 v <- createMatrix ColumnMajor r r 168 v <- createMatrix ColumnMajor r r
173 ww3 withMatrix m withVector l withMatrix v $ \m l v -> 169 app3 zheev mat m vec l mat v "eigH"
174 zheev // m // l // v // check "eigH"
175 return (l,v) 170 return (l,v)
176 where r = rows m 171 where r = rows m
177 172
@@ -182,8 +177,7 @@ foreign import ccall "LAPACK/lapack-aux.h linearSolveC_l" zgesv :: TCMCMCM
182linearSolveSQAux f st a b 177linearSolveSQAux f st a b
183 | n1==n2 && n1==r = unsafePerformIO $ do 178 | n1==n2 && n1==r = unsafePerformIO $ do
184 s <- createMatrix ColumnMajor r c 179 s <- createMatrix ColumnMajor r c
185 ww3 withMatrix a withMatrix b withMatrix s $ \a b s -> 180 app3 f mat a mat b mat s st
186 f // a // b // s // check st
187 return s 181 return s
188 | otherwise = error $ st ++ " of nonsquare matrix" 182 | otherwise = error $ st ++ " of nonsquare matrix"
189 where n1 = rows a 183 where n1 = rows a
@@ -207,8 +201,7 @@ foreign import ccall "LAPACK/lapack-aux.h linearSolveSVDC_l" zgelss :: Double ->
207 201
208linearSolveAux f st a b = unsafePerformIO $ do 202linearSolveAux f st a b = unsafePerformIO $ do
209 r <- createMatrix ColumnMajor (max m n) nrhs 203 r <- createMatrix ColumnMajor (max m n) nrhs
210 ww3 withMatrix a withMatrix b withMatrix r $ \a b r -> 204 app3 f mat a mat b mat r st
211 f // a // b // r // check st
212 return r 205 return r
213 where m = rows a 206 where m = rows a
214 n = cols a 207 n = cols a
@@ -258,8 +251,7 @@ cholS = cholAux dpotrf "cholS" . fmat
258 251
259cholAux f st a = unsafePerformIO $ do 252cholAux f st a = unsafePerformIO $ do
260 r <- createMatrix ColumnMajor n n 253 r <- createMatrix ColumnMajor n n
261 ww2 withMatrix a withMatrix r $ \a r -> 254 app2 f mat a mat r st
262 f // a // r // check st
263 return r 255 return r
264 where n = rows a 256 where n = rows a
265 257
@@ -278,8 +270,7 @@ qrC = qrAux zgeqr2 "qrC" . fmat
278qrAux f st a = unsafePerformIO $ do 270qrAux f st a = unsafePerformIO $ do
279 r <- createMatrix ColumnMajor m n 271 r <- createMatrix ColumnMajor m n
280 tau <- createVector mn 272 tau <- createVector mn
281 ww3 withMatrix a withMatrix r withVector tau $ \ a r tau -> 273 app3 f mat a vec tau mat r st
282 f // a // tau // r // check st
283 return (r,tau) 274 return (r,tau)
284 where m = rows a 275 where m = rows a
285 n = cols a 276 n = cols a
@@ -300,8 +291,7 @@ hessC = hessAux zgehrd "hessC" . fmat
300hessAux f st a = unsafePerformIO $ do 291hessAux f st a = unsafePerformIO $ do
301 r <- createMatrix ColumnMajor m n 292 r <- createMatrix ColumnMajor m n
302 tau <- createVector (mn-1) 293 tau <- createVector (mn-1)
303 ww3 withMatrix a withMatrix r withVector tau $ \ a r tau -> 294 app3 f mat a vec tau mat r st
304 f // a // tau // r // check st
305 return (r,tau) 295 return (r,tau)
306 where m = rows a 296 where m = rows a
307 n = cols a 297 n = cols a
@@ -322,8 +312,7 @@ schurC = schurAux zgees "schurC" . fmat
322schurAux f st a = unsafePerformIO $ do 312schurAux f st a = unsafePerformIO $ do
323 u <- createMatrix ColumnMajor n n 313 u <- createMatrix ColumnMajor n n
324 s <- createMatrix ColumnMajor n n 314 s <- createMatrix ColumnMajor n n
325 ww3 withMatrix a withMatrix u withMatrix s $ \ a u s -> 315 app3 f mat a mat u mat s st
326 f // a // u // s // check st
327 return (u,s) 316 return (u,s)
328 where n = rows a 317 where n = rows a
329 318