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