diff options
Diffstat (limited to 'packages/base/src/Internal/LAPACK.hs')
-rw-r--r-- | packages/base/src/Internal/LAPACK.hs | 35 |
1 files changed, 33 insertions, 2 deletions
diff --git a/packages/base/src/Internal/LAPACK.hs b/packages/base/src/Internal/LAPACK.hs index f2fc68d..c2c140b 100644 --- a/packages/base/src/Internal/LAPACK.hs +++ b/packages/base/src/Internal/LAPACK.hs | |||
@@ -591,7 +591,7 @@ foreign import ccall unsafe "luS_l_C" zgetrs :: C ::> R :> C ::> Ok | |||
591 | lusR :: Matrix Double -> [Int] -> Matrix Double -> Matrix Double | 591 | lusR :: Matrix Double -> [Int] -> Matrix Double -> Matrix Double |
592 | lusR a piv b = lusAux dgetrs "lusR" (fmat a) piv b | 592 | lusR a piv b = lusAux dgetrs "lusR" (fmat a) piv b |
593 | 593 | ||
594 | -- | Solve a real linear system from a precomputed LU decomposition ('luC'), using LAPACK's /zgetrs/. | 594 | -- | Solve a complex linear system from a precomputed LU decomposition ('luC'), using LAPACK's /zgetrs/. |
595 | lusC :: Matrix (Complex Double) -> [Int] -> Matrix (Complex Double) -> Matrix (Complex Double) | 595 | lusC :: Matrix (Complex Double) -> [Int] -> Matrix (Complex Double) -> Matrix (Complex Double) |
596 | lusC a piv b = lusAux zgetrs "lusC" (fmat a) piv b | 596 | lusC a piv b = lusAux zgetrs "lusC" (fmat a) piv b |
597 | 597 | ||
@@ -600,10 +600,41 @@ lusAux f st a piv b | |||
600 | x <- copy ColumnMajor b | 600 | x <- copy ColumnMajor b |
601 | f # a # piv' # x #| st | 601 | f # a # piv' # x #| st |
602 | return x | 602 | return x |
603 | | otherwise = error $ st ++ " on LU factorization of nonsquare matrix" | 603 | | otherwise = error st |
604 | where | 604 | where |
605 | n1 = rows a | 605 | n1 = rows a |
606 | n2 = cols a | 606 | n2 = cols a |
607 | n = rows b | 607 | n = rows b |
608 | piv' = fromList (map (fromIntegral.succ) piv) :: Vector Double | 608 | piv' = fromList (map (fromIntegral.succ) piv) :: Vector Double |
609 | 609 | ||
610 | ----------------------------------------------------------------------------------- | ||
611 | foreign import ccall unsafe "ldl_R" dsytrf :: R :> R ::> Ok | ||
612 | foreign import ccall unsafe "ldl_C" zhetrf :: R :> C ::> Ok | ||
613 | |||
614 | -- | LDL factorization of a symmetric real matrix, using LAPACK's /dsytrf/. | ||
615 | ldlR :: Matrix Double -> (Matrix Double, [Int]) | ||
616 | ldlR = ldlAux dsytrf "ldlR" | ||
617 | |||
618 | -- | LDL factorization of a hermitian complex matrix, using LAPACK's /zhetrf/. | ||
619 | ldlC :: Matrix (Complex Double) -> (Matrix (Complex Double), [Int]) | ||
620 | ldlC = ldlAux zhetrf "ldlC" | ||
621 | |||
622 | ldlAux f st a = unsafePerformIO $ do | ||
623 | ldl <- copy ColumnMajor a | ||
624 | piv <- createVector (rows a) | ||
625 | f # piv # ldl #| st | ||
626 | return (ldl, map (pred.round) (toList piv)) | ||
627 | |||
628 | ----------------------------------------------------------------------------------- | ||
629 | |||
630 | foreign import ccall unsafe "ldl_S_R" dsytrs :: R ::> R :> R ::> Ok | ||
631 | foreign import ccall unsafe "ldl_S_C" zsytrs :: C ::> R :> C ::> Ok | ||
632 | |||
633 | -- | Solve a real linear system from a precomputed LDL decomposition ('ldlR'), using LAPACK's /dsytrs/. | ||
634 | ldlsR :: Matrix Double -> [Int] -> Matrix Double -> Matrix Double | ||
635 | ldlsR a piv b = lusAux dsytrs "ldlsR" (fmat a) piv b | ||
636 | |||
637 | -- | Solve a complex linear system from a precomputed LDL decomposition ('ldlC'), using LAPACK's /zsytrs/. | ||
638 | ldlsC :: Matrix (Complex Double) -> [Int] -> Matrix (Complex Double) -> Matrix (Complex Double) | ||
639 | ldlsC a piv b = lusAux zsytrs "ldlsC" (fmat a) piv b | ||
640 | |||