diff options
Diffstat (limited to 'packages/base/src/Internal')
-rw-r--r-- | packages/base/src/Internal/C/lapack-aux.c | 6 | ||||
-rw-r--r-- | packages/base/src/Internal/LAPACK.hs | 8 |
2 files changed, 8 insertions, 6 deletions
diff --git a/packages/base/src/Internal/C/lapack-aux.c b/packages/base/src/Internal/C/lapack-aux.c index 72c44cb..80e5720 100644 --- a/packages/base/src/Internal/C/lapack-aux.c +++ b/packages/base/src/Internal/C/lapack-aux.c | |||
@@ -1124,6 +1124,7 @@ int dgetrs_(char *trans, integer *n, integer *nrhs, | |||
1124 | int luS_l_R(KODMAT(a), KDVEC(ipiv), ODMAT(b)) { | 1124 | int luS_l_R(KODMAT(a), KDVEC(ipiv), ODMAT(b)) { |
1125 | integer m = ar; | 1125 | integer m = ar; |
1126 | integer n = ac; | 1126 | integer n = ac; |
1127 | integer lda = aXc; | ||
1127 | integer mrhs = br; | 1128 | integer mrhs = br; |
1128 | integer nrhs = bc; | 1129 | integer nrhs = bc; |
1129 | 1130 | ||
@@ -1134,7 +1135,7 @@ int luS_l_R(KODMAT(a), KDVEC(ipiv), ODMAT(b)) { | |||
1134 | auxipiv[k] = (integer)ipivp[k]; | 1135 | auxipiv[k] = (integer)ipivp[k]; |
1135 | } | 1136 | } |
1136 | integer res; | 1137 | integer res; |
1137 | dgetrs_ ("N",&n,&nrhs,(/*no const (!?)*/ double*)ap,&m,auxipiv,bp,&mrhs,&res); | 1138 | dgetrs_ ("N",&n,&nrhs,(/*no const (!?)*/ double*)ap,&lda,auxipiv,bp,&mrhs,&res); |
1138 | CHECK(res,res); | 1139 | CHECK(res,res); |
1139 | free(auxipiv); | 1140 | free(auxipiv); |
1140 | OK | 1141 | OK |
@@ -1148,6 +1149,7 @@ int zgetrs_(char *trans, integer *n, integer *nrhs, | |||
1148 | int luS_l_C(KOCMAT(a), KDVEC(ipiv), OCMAT(b)) { | 1149 | int luS_l_C(KOCMAT(a), KDVEC(ipiv), OCMAT(b)) { |
1149 | integer m = ar; | 1150 | integer m = ar; |
1150 | integer n = ac; | 1151 | integer n = ac; |
1152 | integer lda = aXc; | ||
1151 | integer mrhs = br; | 1153 | integer mrhs = br; |
1152 | integer nrhs = bc; | 1154 | integer nrhs = bc; |
1153 | 1155 | ||
@@ -1158,7 +1160,7 @@ int luS_l_C(KOCMAT(a), KDVEC(ipiv), OCMAT(b)) { | |||
1158 | auxipiv[k] = (integer)ipivp[k]; | 1160 | auxipiv[k] = (integer)ipivp[k]; |
1159 | } | 1161 | } |
1160 | integer res; | 1162 | integer res; |
1161 | zgetrs_ ("N",&n,&nrhs,(doublecomplex*)ap,&m,auxipiv,bp,&mrhs,&res); | 1163 | zgetrs_ ("N",&n,&nrhs,(doublecomplex*)ap,&lda,auxipiv,bp,&mrhs,&res); |
1162 | CHECK(res,res); | 1164 | CHECK(res,res); |
1163 | free(auxipiv); | 1165 | free(auxipiv); |
1164 | OK | 1166 | OK |
diff --git a/packages/base/src/Internal/LAPACK.hs b/packages/base/src/Internal/LAPACK.hs index 049c11e..124e353 100644 --- a/packages/base/src/Internal/LAPACK.hs +++ b/packages/base/src/Internal/LAPACK.hs | |||
@@ -544,11 +544,11 @@ foreign import ccall unsafe "lu_l_C" zgetrf :: R :> C ::> Ok | |||
544 | 544 | ||
545 | -- | LU factorization of a general real matrix, using LAPACK's /dgetrf/. | 545 | -- | LU factorization of a general real matrix, using LAPACK's /dgetrf/. |
546 | luR :: Matrix Double -> (Matrix Double, [Int]) | 546 | luR :: Matrix Double -> (Matrix Double, [Int]) |
547 | luR = luAux dgetrf "luR" . fmat | 547 | luR = luAux dgetrf "luR" |
548 | 548 | ||
549 | -- | LU factorization of a general complex matrix, using LAPACK's /zgetrf/. | 549 | -- | LU factorization of a general complex matrix, using LAPACK's /zgetrf/. |
550 | luC :: Matrix (Complex Double) -> (Matrix (Complex Double), [Int]) | 550 | luC :: Matrix (Complex Double) -> (Matrix (Complex Double), [Int]) |
551 | luC = luAux zgetrf "luC" . fmat | 551 | luC = luAux zgetrf "luC" |
552 | 552 | ||
553 | luAux f st a = unsafePerformIO $ do | 553 | luAux f st a = unsafePerformIO $ do |
554 | lu <- copy ColumnMajor a | 554 | lu <- copy ColumnMajor a |
@@ -566,11 +566,11 @@ foreign import ccall unsafe "luS_l_C" zgetrs :: C ::> R :> C ::> Ok | |||
566 | 566 | ||
567 | -- | Solve a real linear system from a precomputed LU decomposition ('luR'), using LAPACK's /dgetrs/. | 567 | -- | Solve a real linear system from a precomputed LU decomposition ('luR'), using LAPACK's /dgetrs/. |
568 | lusR :: Matrix Double -> [Int] -> Matrix Double -> Matrix Double | 568 | lusR :: Matrix Double -> [Int] -> Matrix Double -> Matrix Double |
569 | lusR a piv b = lusAux dgetrs "lusR" (fmat a) piv (fmat b) | 569 | lusR a piv b = lusAux dgetrs "lusR" (fmat a) piv b |
570 | 570 | ||
571 | -- | Solve a real linear system from a precomputed LU decomposition ('luC'), using LAPACK's /zgetrs/. | 571 | -- | Solve a real linear system from a precomputed LU decomposition ('luC'), using LAPACK's /zgetrs/. |
572 | lusC :: Matrix (Complex Double) -> [Int] -> Matrix (Complex Double) -> Matrix (Complex Double) | 572 | lusC :: Matrix (Complex Double) -> [Int] -> Matrix (Complex Double) -> Matrix (Complex Double) |
573 | lusC a piv b = lusAux zgetrs "lusC" (fmat a) piv (fmat b) | 573 | lusC a piv b = lusAux zgetrs "lusC" (fmat a) piv b |
574 | 574 | ||
575 | lusAux f st a piv b | 575 | lusAux f st a piv b |
576 | | n1==n2 && n2==n =unsafePerformIO $ do | 576 | | n1==n2 && n2==n =unsafePerformIO $ do |