StatProfilerHTML.jl report
Generated on Thu, 21 Dec 2023 13:06:16
File source code
Line Exclusive Inclusive Code
1 # This file is a part of Julia. License is MIT: https://julialang.org/license
2
3 module LAPACK
4 @doc """
5 Interfaces to LAPACK subroutines.
6 """ LAPACK
7
8 using ..LinearAlgebra.BLAS: @blasfunc, chkuplo
9
10 using ..LinearAlgebra: libblastrampoline, BlasFloat, BlasInt, LAPACKException, DimensionMismatch,
11 SingularException, PosDefException, chkstride1, checksquare,triu, tril, dot
12
13 using Base: iszero, require_one_based_indexing
14
15
16 # Legacy binding maintained for backwards-compatibility but new packages
17 # should not look at this, instead preferring to parse the output
18 # of BLAS.get_config()
19 const liblapack = libblastrampoline
20
21 #Generic LAPACK error handlers
22 """
23 Handle only negative LAPACK error codes
24
25 *NOTE* use only if the positive error code is useful.
26 """
27 function chkargsok(ret::BlasInt)
28 if ret < 0
29 throw(ArgumentError("invalid argument #$(-ret) to LAPACK call"))
30 end
31 end
32
33 "Handle all nonzero info codes"
34 function chklapackerror(ret::BlasInt)
35 if ret == 0
36 return
37 elseif ret < 0
38 throw(ArgumentError("invalid argument #$(-ret) to LAPACK call"))
39 else # ret > 0
40 throw(LAPACKException(ret))
41 end
42 end
43
44 function chknonsingular(ret::BlasInt)
45 if ret > 0
46 throw(SingularException(ret))
47 end
48 end
49
50 function chkposdef(ret::BlasInt)
51 if ret > 0
52 throw(PosDefException(ret))
53 end
54 end
55
56 "Check that {c}transpose is correctly specified"
57 function chktrans(trans::AbstractChar)
58 if !(trans == 'N' || trans == 'C' || trans == 'T')
59 throw(ArgumentError("trans argument must be 'N' (no transpose), 'T' (transpose), or 'C' (conjugate transpose), got $trans"))
60 end
61 trans
62 end
63
64 "Check that left/right hand side multiply is correctly specified"
65 function chkside(side::AbstractChar)
66 if !(side == 'L' || side == 'R')
67 throw(ArgumentError("side argument must be 'L' (left hand multiply) or 'R' (right hand multiply), got $side"))
68 end
69 side
70 end
71
72 "Check that unit diagonal flag is correctly specified"
73 function chkdiag(diag::AbstractChar)
74 if !(diag == 'U' || diag =='N')
75 throw(ArgumentError("diag argument must be 'U' (unit diagonal) or 'N' (non-unit diagonal), got $diag"))
76 end
77 diag
78 end
79
80 subsetrows(X::AbstractVector, Y::AbstractArray, k) = Y[1:k]
81 subsetrows(X::AbstractMatrix, Y::AbstractArray, k) = Y[1:k, :]
82
83 function chkfinite(A::AbstractMatrix)
84 for a in A
85 if !isfinite(a)
86 throw(ArgumentError("matrix contains Infs or NaNs"))
87 end
88 end
89 return true
90 end
91
92 function chkuplofinite(A::AbstractMatrix, uplo::AbstractChar)
93 require_one_based_indexing(A)
94 m, n = size(A)
95 if uplo == 'U'
96 @inbounds for j in 1:n, i in 1:j
97 if !isfinite(A[i,j])
98 throw(ArgumentError("matrix contains Infs or NaNs"))
99 end
100 end
101 else
102 @inbounds for j in 1:n, i in j:m
103 if !isfinite(A[i,j])
104 throw(ArgumentError("matrix contains Infs or NaNs"))
105 end
106 end
107 end
108 end
109
110 # LAPACK version number
111 function version()
112 major = Ref{BlasInt}(0)
113 minor = Ref{BlasInt}(0)
114 patch = Ref{BlasInt}(0)
115 ccall((@blasfunc(ilaver_), libblastrampoline), Cvoid,
116 (Ptr{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}),
117 major, minor, patch)
118 return VersionNumber(major[], minor[], patch[])
119 end
120
121 # (GB) general banded matrices, LU decomposition and solver
122 for (gbtrf, gbtrs, elty) in
123 ((:dgbtrf_,:dgbtrs_,:Float64),
124 (:sgbtrf_,:sgbtrs_,:Float32),
125 (:zgbtrf_,:zgbtrs_,:ComplexF64),
126 (:cgbtrf_,:cgbtrs_,:ComplexF32))
127 @eval begin
128 # SUBROUTINE DGBTRF( M, N, KL, KU, AB, LDAB, IPIV, INFO )
129 # * .. Scalar Arguments ..
130 # INTEGER INFO, KL, KU, LDAB, M, N
131 # * .. Array Arguments ..
132 # INTEGER IPIV( * )
133 # DOUBLE PRECISION AB( LDAB, * )
134 function gbtrf!(kl::Integer, ku::Integer, m::Integer, AB::AbstractMatrix{$elty})
135 require_one_based_indexing(AB)
136 chkstride1(AB)
137 n = size(AB, 2)
138 mnmn = min(m, n)
139 ipiv = similar(AB, BlasInt, mnmn)
140 info = Ref{BlasInt}()
141 ccall((@blasfunc($gbtrf), libblastrampoline), Cvoid,
142 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
143 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}),
144 m, n, kl, ku, AB, max(1,stride(AB,2)), ipiv, info)
145 chklapackerror(info[])
146 AB, ipiv
147 end
148
149 # SUBROUTINE DGBTRS( TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
150 # * .. Scalar Arguments ..
151 # CHARACTER TRANS
152 # INTEGER INFO, KL, KU, LDAB, LDB, N, NRHS
153 # * .. Array Arguments ..
154 # INTEGER IPIV( * )
155 # DOUBLE PRECISION AB( LDAB, * ), B( LDB, * )
156 function gbtrs!(trans::AbstractChar, kl::Integer, ku::Integer, m::Integer,
157 AB::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt},
158 B::AbstractVecOrMat{$elty})
159 require_one_based_indexing(AB, B)
160 chkstride1(AB, B, ipiv)
161 chktrans(trans)
162 info = Ref{BlasInt}()
163 n = size(AB,2)
164 if m != n || m != size(B,1)
165 throw(DimensionMismatch("matrix AB has dimensions $(size(AB)), but right hand side matrix B has dimensions $(size(B))"))
166 end
167 ccall((@blasfunc($gbtrs), libblastrampoline), Cvoid,
168 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
169 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt},
170 Ptr{BlasInt}, Clong),
171 trans, n, kl, ku, size(B,2), AB, max(1,stride(AB,2)), ipiv,
172 B, max(1,stride(B,2)), info, 1)
173 chklapackerror(info[])
174 B
175 end
176 end
177 end
178
179 """
180 gbtrf!(kl, ku, m, AB) -> (AB, ipiv)
181
182 Compute the LU factorization of a banded matrix `AB`. `kl` is the first
183 subdiagonal containing a nonzero band, `ku` is the last superdiagonal
184 containing one, and `m` is the first dimension of the matrix `AB`. Returns
185 the LU factorization in-place and `ipiv`, the vector of pivots used.
186 """
187 gbtrf!(kl::Integer, ku::Integer, m::Integer, AB::AbstractMatrix)
188
189 """
190 gbtrs!(trans, kl, ku, m, AB, ipiv, B)
191
192 Solve the equation `AB * X = B`. `trans` determines the orientation of `AB`. It may
193 be `N` (no transpose), `T` (transpose), or `C` (conjugate transpose). `kl` is the
194 first subdiagonal containing a nonzero band, `ku` is the last superdiagonal
195 containing one, and `m` is the first dimension of the matrix `AB`. `ipiv` is the vector
196 of pivots returned from `gbtrf!`. Returns the vector or matrix `X`, overwriting `B` in-place.
197 """
198 gbtrs!(trans::AbstractChar, kl::Integer, ku::Integer, m::Integer, AB::AbstractMatrix, ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat)
199
200 ## (GE) general matrices: balancing and back-transforming
201 for (gebal, gebak, elty, relty) in
202 ((:dgebal_, :dgebak_, :Float64, :Float64),
203 (:sgebal_, :sgebak_, :Float32, :Float32),
204 (:zgebal_, :zgebak_, :ComplexF64, :Float64),
205 (:cgebal_, :cgebak_, :ComplexF32, :Float32))
206 @eval begin
207 # SUBROUTINE DGEBAL( JOB, N, A, LDA, ILO, IHI, SCALE, INFO )
208 #* .. Scalar Arguments ..
209 # CHARACTER JOB
210 # INTEGER IHI, ILP, INFO, LDA, N
211 # .. Array Arguments ..
212 # DOUBLE PRECISION A( LDA, * ), SCALE( * )
213 function gebal!(job::AbstractChar, A::AbstractMatrix{$elty})
214 chkstride1(A)
215 n = checksquare(A)
216 chkfinite(A) # balancing routines don't support NaNs and Infs
217 ihi = Ref{BlasInt}()
218 ilo = Ref{BlasInt}()
219 scale = similar(A, $relty, n)
220 info = Ref{BlasInt}()
221 ccall((@blasfunc($gebal), libblastrampoline), Cvoid,
222 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
223 Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$relty}, Ptr{BlasInt}, Clong),
224 job, n, A, max(1,stride(A,2)), ilo, ihi, scale, info, 1)
225 chklapackerror(info[])
226 ilo[], ihi[], scale
227 end
228
229 # SUBROUTINE DGEBAK( JOB, SIDE, N, ILO, IHI, SCALE, M, V, LDV, INFO )
230 #* .. Scalar Arguments ..
231 # CHARACTER JOB, SIDE
232 # INTEGER IHI, ILP, INFO, LDV, M, N
233 # .. Array Arguments ..
234 # DOUBLE PRECISION SCALE( * ), V( LDV, * )
235 function gebak!(job::AbstractChar, side::AbstractChar,
236 ilo::BlasInt, ihi::BlasInt, scale::AbstractVector{$relty},
237 V::AbstractMatrix{$elty})
238 require_one_based_indexing(scale, V)
239 chkstride1(scale, V)
240 chkside(side)
241 chkfinite(V) # balancing routines don't support NaNs and Infs
242 n = checksquare(V)
243 info = Ref{BlasInt}()
244 ccall((@blasfunc($gebak), libblastrampoline), Cvoid,
245 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
246 Ptr{$relty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
247 Clong, Clong),
248 job, side, size(V,1), ilo, ihi, scale, n, V, max(1,stride(V,2)), info,
249 1, 1)
250 chklapackerror(info[])
251 V
252 end
253 end
254 end
255
256 """
257 gebal!(job, A) -> (ilo, ihi, scale)
258
259 Balance the matrix `A` before computing its eigensystem or Schur factorization.
260 `job` can be one of `N` (`A` will not be permuted or scaled), `P` (`A` will only
261 be permuted), `S` (`A` will only be scaled), or `B` (`A` will be both permuted
262 and scaled). Modifies `A` in-place and returns `ilo`, `ihi`, and `scale`. If
263 permuting was turned on, `A[i,j] = 0` if `j > i` and `1 < j < ilo` or `j > ihi`.
264 `scale` contains information about the scaling/permutations performed.
265 """
266 gebal!(job::AbstractChar, A::AbstractMatrix)
267
268 """
269 gebak!(job, side, ilo, ihi, scale, V)
270
271 Transform the eigenvectors `V` of a matrix balanced using `gebal!` to
272 the unscaled/unpermuted eigenvectors of the original matrix. Modifies `V`
273 in-place. `side` can be `L` (left eigenvectors are transformed) or `R`
274 (right eigenvectors are transformed).
275 """
276 gebak!(job::AbstractChar, side::AbstractChar, ilo::BlasInt, ihi::BlasInt, scale::AbstractVector, V::AbstractMatrix)
277
278 # (GE) general matrices, direct decompositions
279 #
280 # These mutating functions take as arguments all the values they
281 # return, even if the value of the function does not depend on them
282 # (e.g. the tau argument). This is so that a factorization can be
283 # updated in place. The condensed mutating functions, usually a
284 # function of A only, are defined after this block.
285 for (gebrd, gelqf, geqlf, geqrf, geqp3, geqrt, geqrt3, gerqf, getrf, elty, relty) in
286 ((:dgebrd_,:dgelqf_,:dgeqlf_,:dgeqrf_,:dgeqp3_,:dgeqrt_,:dgeqrt3_,:dgerqf_,:dgetrf_,:Float64,:Float64),
287 (:sgebrd_,:sgelqf_,:sgeqlf_,:sgeqrf_,:sgeqp3_,:sgeqrt_,:sgeqrt3_,:sgerqf_,:sgetrf_,:Float32,:Float32),
288 (:zgebrd_,:zgelqf_,:zgeqlf_,:zgeqrf_,:zgeqp3_,:zgeqrt_,:zgeqrt3_,:zgerqf_,:zgetrf_,:ComplexF64,:Float64),
289 (:cgebrd_,:cgelqf_,:cgeqlf_,:cgeqrf_,:cgeqp3_,:cgeqrt_,:cgeqrt3_,:cgerqf_,:cgetrf_,:ComplexF32,:Float32))
290 @eval begin
291 # SUBROUTINE DGEBRD( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, LWORK,
292 # INFO )
293 # .. Scalar Arguments ..
294 # INTEGER INFO, LDA, LWORK, M, N
295 # .. Array Arguments ..
296 # DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAUP( * ),
297 # TAUQ( * ), WORK( * )
298 function gebrd!(A::AbstractMatrix{$elty})
299 require_one_based_indexing(A)
300 chkstride1(A)
301 m, n = size(A)
302 k = min(m, n)
303 d = similar(A, $relty, k)
304 e = similar(A, $relty, k)
305 tauq = similar(A, $elty, k)
306 taup = similar(A, $elty, k)
307 work = Vector{$elty}(undef, 1)
308 lwork = BlasInt(-1)
309 info = Ref{BlasInt}()
310 for i = 1:2 # first call returns lwork as work[1]
311 ccall((@blasfunc($gebrd), libblastrampoline), Cvoid,
312 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
313 Ptr{$relty}, Ptr{$relty}, Ptr{$elty}, Ptr{$elty},
314 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
315 m, n, A, max(1,stride(A,2)),
316 d, e, tauq, taup,
317 work, lwork, info)
318 chklapackerror(info[])
319 if i == 1
320 lwork = BlasInt(real(work[1]))
321 resize!(work, lwork)
322 end
323 end
324 A, d, e, tauq, taup
325 end
326
327 # SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
328 # * .. Scalar Arguments ..
329 # INTEGER INFO, LDA, LWORK, M, N
330 # * .. Array Arguments ..
331 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
332 function gelqf!(A::AbstractMatrix{$elty}, tau::AbstractVector{$elty})
333 require_one_based_indexing(A, tau)
334 chkstride1(A,tau)
335 m = BlasInt(size(A, 1))
336 n = BlasInt(size(A, 2))
337 lda = BlasInt(max(1,stride(A, 2)))
338 if length(tau) != min(m,n)
339 throw(DimensionMismatch("tau has length $(length(tau)), but needs length $(min(m,n))"))
340 end
341 lwork = BlasInt(-1)
342 work = Vector{$elty}(undef, 1)
343 info = Ref{BlasInt}()
344 for i = 1:2 # first call returns lwork as work[1]
345 ccall((@blasfunc($gelqf), libblastrampoline), Cvoid,
346 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
347 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
348 m, n, A, lda, tau, work, lwork, info)
349 chklapackerror(info[])
350 if i == 1
351 lwork = BlasInt(real(work[1]))
352 resize!(work, lwork)
353 end
354 end
355 A, tau
356 end
357
358 # SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
359 # * .. Scalar Arguments ..
360 # INTEGER INFO, LDA, LWORK, M, N
361 # * .. Array Arguments ..
362 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
363 function geqlf!(A::AbstractMatrix{$elty}, tau::AbstractVector{$elty})
364 require_one_based_indexing(A, tau)
365 chkstride1(A,tau)
366 m = BlasInt(size(A, 1))
367 n = BlasInt(size(A, 2))
368 lda = BlasInt(max(1,stride(A, 2)))
369 if length(tau) != min(m,n)
370 throw(DimensionMismatch("tau has length $(length(tau)), but needs length $(min(m,n))"))
371 end
372 lwork = BlasInt(-1)
373 work = Vector{$elty}(undef, 1)
374 info = Ref{BlasInt}()
375 for i = 1:2 # first call returns lwork as work[1]
376 ccall((@blasfunc($geqlf), libblastrampoline), Cvoid,
377 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
378 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
379 m, n, A, lda, tau, work, lwork, info)
380 chklapackerror(info[])
381 if i == 1
382 lwork = BlasInt(real(work[1]))
383 resize!(work, lwork)
384 end
385 end
386 A, tau
387 end
388
389 # SUBROUTINE DGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
390 # * .. Scalar Arguments ..
391 # INTEGER INFO, LDA, LWORK, M, N
392 # * .. Array Arguments ..
393 # INTEGER JPVT( * )
394 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
395 function geqp3!(A::AbstractMatrix{$elty}, jpvt::AbstractVector{BlasInt}, tau::AbstractVector{$elty})
396 require_one_based_indexing(A, jpvt, tau)
397 chkstride1(A,jpvt,tau)
398 m,n = size(A)
399 if length(tau) != min(m,n)
400 throw(DimensionMismatch("tau has length $(length(tau)), but needs length $(min(m,n))"))
401 end
402 if length(jpvt) != n
403 throw(DimensionMismatch("jpvt has length $(length(jpvt)), but needs length $n"))
404 end
405 lda = stride(A,2)
406 if lda == 0
407 return A, tau, jpvt
408 end # Early exit
409 work = Vector{$elty}(undef, 1)
410 lwork = BlasInt(-1)
411 cmplx = eltype(A)<:Complex
412 if cmplx
413 rwork = Vector{$relty}(undef, 2n)
414 end
415 info = Ref{BlasInt}()
416 for i = 1:2 # first call returns lwork as work[1]
417 if cmplx
418 ccall((@blasfunc($geqp3), libblastrampoline), Cvoid,
419 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
420 Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
421 Ptr{$relty}, Ptr{BlasInt}),
422 m, n, A, lda,
423 jpvt, tau, work, lwork,
424 rwork, info)
425 else
426 ccall((@blasfunc($geqp3), libblastrampoline), Cvoid,
427 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
428 Ptr{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
429 Ptr{BlasInt}),
430 m, n, A, lda,
431 jpvt, tau, work,
432 lwork, info)
433 end
434 chklapackerror(info[])
435 if i == 1
436 lwork = BlasInt(real(work[1]))
437 resize!(work, lwork)
438 end
439 end
440 return A, tau, jpvt
441 end
442
443 function geqrt!(A::AbstractMatrix{$elty}, T::AbstractMatrix{$elty})
444 require_one_based_indexing(A, T)
445 chkstride1(A)
446 m, n = size(A)
447 minmn = min(m, n)
448 nb = size(T, 1)
449 if nb > minmn
450 throw(ArgumentError("block size $nb > $minmn too large"))
451 end
452 lda = max(1, stride(A,2))
453 work = Vector{$elty}(undef, nb*n)
454 if n > 0
455 info = Ref{BlasInt}()
456 ccall((@blasfunc($geqrt), libblastrampoline), Cvoid,
457 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
458 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
459 Ptr{BlasInt}),
460 m, n, nb, A,
461 lda, T, max(1,stride(T,2)), work,
462 info)
463 chklapackerror(info[])
464 end
465 A, T
466 end
467
468 function geqrt3!(A::AbstractMatrix{$elty}, T::AbstractMatrix{$elty})
469 require_one_based_indexing(A, T)
470 chkstride1(A)
471 chkstride1(T)
472 m, n = size(A)
473 p, q = size(T)
474 if m < n
475 throw(DimensionMismatch("input matrix A has dimensions ($m,$n), but should have more rows than columns"))
476 end
477 if p != n || q != n
478 throw(DimensionMismatch("block reflector T has dimensions ($p,$q), but should have dimensions ($n,$n)"))
479 end
480 if n > 0
481 info = Ref{BlasInt}()
482 ccall((@blasfunc($geqrt3), libblastrampoline), Cvoid,
483 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
484 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
485 m, n, A, max(1, stride(A, 2)),
486 T, max(1,stride(T,2)), info)
487 chklapackerror(info[])
488 end
489 A, T
490 end
491
492 ## geqrfp! - positive elements on diagonal of R - not defined yet
493 # SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
494 # * .. Scalar Arguments ..
495 # INTEGER INFO, LDA, LWORK, M, N
496 # * .. Array Arguments ..
497 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
498 function geqrf!(A::AbstractMatrix{$elty}, tau::AbstractVector{$elty})
499 require_one_based_indexing(A, tau)
500 chkstride1(A,tau)
501 m, n = size(A)
502 if length(tau) != min(m,n)
503 throw(DimensionMismatch("tau has length $(length(tau)), but needs length $(min(m,n))"))
504 end
505 work = Vector{$elty}(undef, 1)
506 lwork = BlasInt(-1)
507 info = Ref{BlasInt}()
508 for i = 1:2 # first call returns lwork as work[1]
509 ccall((@blasfunc($geqrf), libblastrampoline), Cvoid,
510 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
511 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
512 m, n, A, max(1,stride(A,2)), tau, work, lwork, info)
513 chklapackerror(info[])
514 if i == 1
515 lwork = max(BlasInt(1),BlasInt(real(work[1])))
516 resize!(work, lwork)
517 end
518 end
519 A, tau
520 end
521
522 # SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
523 # * .. Scalar Arguments ..
524 # INTEGER INFO, LDA, LWORK, M, N
525 # * .. Array Arguments ..
526 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
527 function gerqf!(A::AbstractMatrix{$elty},tau::AbstractVector{$elty})
528 require_one_based_indexing(A, tau)
529 chkstride1(A,tau)
530 m, n = size(A)
531 if length(tau) != min(m,n)
532 throw(DimensionMismatch("tau has length $(length(tau)), but needs length $(min(m,n))"))
533 end
534 lwork = BlasInt(-1)
535 work = Vector{$elty}(undef, 1)
536 info = Ref{BlasInt}()
537 for i = 1:2 # first call returns lwork as work[1]
538 ccall((@blasfunc($gerqf), libblastrampoline), Cvoid,
539 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
540 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
541 m, n, A, max(1,stride(A,2)), tau, work, lwork, info)
542 chklapackerror(info[])
543 if i == 1
544 lwork = max(BlasInt(m), BlasInt(real(work[1])))
545 resize!(work, lwork)
546 end
547 end
548 A, tau
549 end
550
551 # SUBROUTINE DGETRF( M, N, A, LDA, IPIV, INFO )
552 # * .. Scalar Arguments ..
553 # INTEGER INFO, LDA, M, N
554 # * .. Array Arguments ..
555 # INTEGER IPIV( * )
556 # DOUBLE PRECISION A( LDA, * )
557 function getrf!(A::AbstractMatrix{$elty}; check = true)
558 require_one_based_indexing(A)
559 check && chkfinite(A)
560 chkstride1(A)
561 m, n = size(A)
562 lda = max(1,stride(A, 2))
563 ipiv = similar(A, BlasInt, min(m,n))
564 info = Ref{BlasInt}()
565 ccall((@blasfunc($getrf), libblastrampoline), Cvoid,
566 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
567 Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}),
568 m, n, A, lda, ipiv, info)
569 chkargsok(info[])
570 A, ipiv, info[] #Error code is stored in LU factorization type
571 end
572 end
573 end
574
575 """
576 gebrd!(A) -> (A, d, e, tauq, taup)
577
578 Reduce `A` in-place to bidiagonal form `A = QBP'`. Returns `A`, containing the
579 bidiagonal matrix `B`; `d`, containing the diagonal elements of `B`; `e`,
580 containing the off-diagonal elements of `B`; `tauq`, containing the
581 elementary reflectors representing `Q`; and `taup`, containing the
582 elementary reflectors representing `P`.
583 """
584 gebrd!(A::AbstractMatrix)
585
586 """
587 gelqf!(A, tau)
588
589 Compute the `LQ` factorization of `A`, `A = LQ`. `tau` contains scalars
590 which parameterize the elementary reflectors of the factorization. `tau`
591 must have length greater than or equal to the smallest dimension of `A`.
592
593 Returns
594 `A` and `tau` modified in-place.
595 """
596 gelqf!(A::AbstractMatrix, tau::AbstractVector)
597
598 """
599 geqlf!(A, tau)
600
601 Compute the `QL` factorization of `A`, `A = QL`. `tau` contains scalars
602 which parameterize the elementary reflectors of the factorization. `tau`
603 must have length greater than or equal to the smallest dimension of `A`.
604
605 Returns `A` and `tau` modified in-place.
606 """
607 geqlf!(A::AbstractMatrix, tau::AbstractVector)
608
609 """
610 geqp3!(A, [jpvt, tau]) -> (A, tau, jpvt)
611
612 Compute the pivoted `QR` factorization of `A`, `AP = QR` using BLAS level 3.
613 `P` is a pivoting matrix, represented by `jpvt`. `tau` stores the elementary
614 reflectors. The arguments `jpvt` and `tau` are optional and allow
615 for passing preallocated arrays. When passed, `jpvt` must have length greater
616 than or equal to `n` if `A` is an `(m x n)` matrix and `tau` must have length
617 greater than or equal to the smallest dimension of `A`.
618
619 `A`, `jpvt`, and `tau` are modified in-place.
620 """
621 geqp3!(A::AbstractMatrix, jpvt::AbstractVector{BlasInt}, tau::AbstractVector)
622
623 function geqp3!(A::AbstractMatrix{<:BlasFloat}, jpvt::AbstractVector{BlasInt})
624 m, n = size(A)
625 geqp3!(A, jpvt, similar(A, min(m, n)))
626 end
627
628 function geqp3!(A::AbstractMatrix{<:BlasFloat})
629 m, n = size(A)
630 geqp3!(A, zeros(BlasInt, n), similar(A, min(m, n)))
631 end
632
633 """
634 geqrt!(A, T)
635
636 Compute the blocked `QR` factorization of `A`, `A = QR`. `T` contains upper
637 triangular block reflectors which parameterize the elementary reflectors of
638 the factorization. The first dimension of `T` sets the block size and it must
639 be between 1 and `n`. The second dimension of `T` must equal the smallest
640 dimension of `A`.
641
642 Returns `A` and `T` modified in-place.
643 """
644 geqrt!(A::AbstractMatrix, T::AbstractMatrix)
645
646 """
647 geqrt3!(A, T)
648
649 Recursively computes the blocked `QR` factorization of `A`, `A = QR`. `T`
650 contains upper triangular block reflectors which parameterize the
651 elementary reflectors of the factorization. The first dimension of `T` sets the
652 block size and it must be between 1 and `n`. The second dimension of `T` must
653 equal the smallest dimension of `A`.
654
655 Returns `A` and `T` modified in-place.
656 """
657 geqrt3!(A::AbstractMatrix, T::AbstractMatrix)
658
659 """
660 geqrf!(A, tau)
661
662 Compute the `QR` factorization of `A`, `A = QR`. `tau` contains scalars
663 which parameterize the elementary reflectors of the factorization. `tau`
664 must have length greater than or equal to the smallest dimension of `A`.
665
666 Returns `A` and `tau` modified in-place.
667 """
668 geqrf!(A::AbstractMatrix, tau::AbstractVector)
669
670 """
671 gerqf!(A, tau)
672
673 Compute the `RQ` factorization of `A`, `A = RQ`. `tau` contains scalars
674 which parameterize the elementary reflectors of the factorization. `tau`
675 must have length greater than or equal to the smallest dimension of `A`.
676
677 Returns `A` and `tau` modified in-place.
678 """
679 gerqf!(A::AbstractMatrix, tau::AbstractVector)
680
681 """
682 getrf!(A) -> (A, ipiv, info)
683
684 Compute the pivoted `LU` factorization of `A`, `A = LU`.
685
686 Returns `A`, modified in-place, `ipiv`, the pivoting information, and an `info`
687 code which indicates success (`info = 0`), a singular value in `U`
688 (`info = i`, in which case `U[i,i]` is singular), or an error code (`info < 0`).
689 """
690 getrf!(A::AbstractMatrix, tau::AbstractVector)
691
692 """
693 gelqf!(A) -> (A, tau)
694
695 Compute the `LQ` factorization of `A`, `A = LQ`.
696
697 Returns `A`, modified in-place, and `tau`, which contains scalars
698 which parameterize the elementary reflectors of the factorization.
699 """
700 gelqf!(A::AbstractMatrix{<:BlasFloat}) = ((m,n) = size(A); gelqf!(A, similar(A, min(m, n))))
701
702 """
703 geqlf!(A) -> (A, tau)
704
705 Compute the `QL` factorization of `A`, `A = QL`.
706
707 Returns `A`, modified in-place, and `tau`, which contains scalars
708 which parameterize the elementary reflectors of the factorization.
709 """
710 geqlf!(A::AbstractMatrix{<:BlasFloat}) = ((m,n) = size(A); geqlf!(A, similar(A, min(m, n))))
711
712 """
713 geqrt!(A, nb) -> (A, T)
714
715 Compute the blocked `QR` factorization of `A`, `A = QR`. `nb` sets the block size
716 and it must be between 1 and `n`, the second dimension of `A`.
717
718 Returns `A`, modified in-place, and `T`, which contains upper
719 triangular block reflectors which parameterize the elementary reflectors of
720 the factorization.
721 """
722 geqrt!(A::AbstractMatrix{<:BlasFloat}, nb::Integer) = geqrt!(A, similar(A, nb, minimum(size(A))))
723
724 """
725 geqrt3!(A) -> (A, T)
726
727 Recursively computes the blocked `QR` factorization of `A`, `A = QR`.
728
729 Returns `A`, modified in-place, and `T`, which contains upper triangular block
730 reflectors which parameterize the elementary reflectors of the factorization.
731 """
732 geqrt3!(A::AbstractMatrix{<:BlasFloat}) = (n = size(A, 2); geqrt3!(A, similar(A, n, n)))
733
734 """
735 geqrf!(A) -> (A, tau)
736
737 Compute the `QR` factorization of `A`, `A = QR`.
738
739 Returns `A`, modified in-place, and `tau`, which contains scalars
740 which parameterize the elementary reflectors of the factorization.
741 """
742 geqrf!(A::AbstractMatrix{<:BlasFloat}) = ((m,n) = size(A); geqrf!(A, similar(A, min(m, n))))
743
744 """
745 gerqf!(A) -> (A, tau)
746
747 Compute the `RQ` factorization of `A`, `A = RQ`.
748
749 Returns `A`, modified in-place, and `tau`, which contains scalars
750 which parameterize the elementary reflectors of the factorization.
751 """
752 gerqf!(A::AbstractMatrix{<:BlasFloat}) = ((m,n) = size(A); gerqf!(A, similar(A, min(m, n))))
753
754 ## Tools to compute and apply elementary reflectors
755 for (larfg, elty) in
756 ((:dlarfg_, Float64),
757 (:slarfg_, Float32),
758 (:zlarfg_, ComplexF64),
759 (:clarfg_, ComplexF32))
760 @eval begin
761 # .. Scalar Arguments ..
762 # INTEGER incx, n
763 # DOUBLE PRECISION alpha, tau
764 # ..
765 # .. Array Arguments ..
766 # DOUBLE PRECISION x( * )
767 function larfg!(x::AbstractVector{$elty})
768 N = BlasInt(length(x))
769 α = Ref{$elty}(x[1])
770 incx = BlasInt(1)
771 Ï„ = Ref{$elty}(0)
772 ccall((@blasfunc($larfg), libblastrampoline), Cvoid,
773 (Ref{BlasInt}, Ref{$elty}, Ptr{$elty}, Ref{BlasInt}, Ref{$elty}),
774 N, α, pointer(x, 2), incx, τ)
775 @inbounds x[1] = one($elty)
776 return Ï„[]
777 end
778 end
779 end
780
781 for (larf, elty) in
782 ((:dlarf_, Float64),
783 (:slarf_, Float32),
784 (:zlarf_, ComplexF64),
785 (:clarf_, ComplexF32))
786 @eval begin
787 # .. Scalar Arguments ..
788 # CHARACTER side
789 # INTEGER incv, ldc, m, n
790 # DOUBLE PRECISION tau
791 # ..
792 # .. Array Arguments ..
793 # DOUBLE PRECISION c( ldc, * ), v( * ), work( * )
794 function larf!(side::AbstractChar, v::AbstractVector{$elty},
795 Ï„::$elty, C::AbstractMatrix{$elty}, work::AbstractVector{$elty})
796 m, n = size(C)
797 chkside(side)
798 ldc = max(1, stride(C, 2))
799 l = side == 'L' ? n : m
800 incv = BlasInt(1)
801 ccall((@blasfunc($larf), libblastrampoline), Cvoid,
802 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
803 Ref{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Clong),
804 side, m, n, v, incv,
805 Ï„, C, ldc, work, 1)
806 return C
807 end
808
809 function larf!(side::AbstractChar, v::AbstractVector{$elty},
810 Ï„::$elty, C::AbstractMatrix{$elty})
811 m, n = size(C)
812 chkside(side)
813 lwork = side == 'L' ? n : m
814 return larf!(side, v, Ï„, C, Vector{$elty}(undef,lwork))
815 end
816 end
817 end
818
819 ## Complete orthogonaliztion tools
820 for (tzrzf, ormrz, elty) in
821 ((:dtzrzf_,:dormrz_,:Float64),
822 (:stzrzf_,:sormrz_,:Float32),
823 (:ztzrzf_,:zunmrz_,:ComplexF64),
824 (:ctzrzf_,:cunmrz_,:ComplexF32))
825 @eval begin
826 # SUBROUTINE ZTZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
827 #
828 # .. Scalar Arguments ..
829 # INTEGER INFO, LDA, LWORK, M, N
830 # ..
831 # .. Array Arguments ..
832 # COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
833 function tzrzf!(A::AbstractMatrix{$elty})
834 require_one_based_indexing(A)
835 chkstride1(A)
836 m, n = size(A)
837 if n < m
838 throw(DimensionMismatch("input matrix A has dimensions ($m,$n), but cannot have fewer columns than rows"))
839 end
840 lda = max(1, stride(A,2))
841 tau = similar(A, $elty, m)
842 work = Vector{$elty}(undef, 1)
843 lwork = BlasInt(-1)
844 info = Ref{BlasInt}()
845 for i = 1:2 # first call returns lwork as work[1]
846 ccall((@blasfunc($tzrzf), libblastrampoline), Cvoid,
847 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
848 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
849 m, n, A, lda,
850 tau, work, lwork, info)
851 chklapackerror(info[])
852 if i == 1
853 lwork = BlasInt(real(work[1]))
854 resize!(work, lwork)
855 end
856 end
857 A, tau
858 end
859
860 # SUBROUTINE ZUNMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
861 # WORK, LWORK, INFO )
862 #
863 # .. Scalar Arguments ..
864 # CHARACTER SIDE, TRANS
865 # INTEGER INFO, K, L, LDA, LDC, LWORK, M, N
866 # ..
867 # .. Array Arguments ..
868 # COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
869 function ormrz!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
870 tau::AbstractVector{$elty}, C::AbstractMatrix{$elty})
871 require_one_based_indexing(A, tau, C)
872 chktrans(trans)
873 chkside(side)
874 chkstride1(A, tau, C)
875 m, n = size(C)
876 k = length(tau)
877 l = size(A, 2) - size(A, 1)
878 lda = max(1, stride(A,2))
879 ldc = max(1, stride(C,2))
880 work = Vector{$elty}(undef, 1)
881 lwork = BlasInt(-1)
882 info = Ref{BlasInt}()
883 for i = 1:2 # first call returns lwork as work[1]
884 ccall((@blasfunc($ormrz), libblastrampoline), Cvoid,
885 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
886 Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
887 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
888 Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
889 side, trans, m, n,
890 k, l, A, lda,
891 tau, C, ldc, work,
892 lwork, info, 1, 1)
893 chklapackerror(info[])
894 if i == 1
895 lwork = BlasInt(real(work[1]))
896 resize!(work, lwork)
897 end
898 end
899 C
900 end
901 end
902 end
903
904 """
905 ormrz!(side, trans, A, tau, C)
906
907 Multiplies the matrix `C` by `Q` from the transformation supplied by
908 `tzrzf!`. Depending on `side` or `trans` the multiplication can be
909 left-sided (`side = L, Q*C`) or right-sided (`side = R, C*Q`) and `Q`
910 can be unmodified (`trans = N`), transposed (`trans = T`), or conjugate
911 transposed (`trans = C`). Returns matrix `C` which is modified in-place
912 with the result of the multiplication.
913 """
914 ormrz!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix, tau::AbstractVector, C::AbstractMatrix)
915
916 """
917 tzrzf!(A) -> (A, tau)
918
919 Transforms the upper trapezoidal matrix `A` to upper triangular form in-place.
920 Returns `A` and `tau`, the scalar parameters for the elementary reflectors
921 of the transformation.
922 """
923 tzrzf!(A::AbstractMatrix)
924
925 ## (GE) general matrices, solvers with factorization, solver and inverse
926 for (gels, gesv, getrs, getri, elty) in
927 ((:dgels_,:dgesv_,:dgetrs_,:dgetri_,:Float64),
928 (:sgels_,:sgesv_,:sgetrs_,:sgetri_,:Float32),
929 (:zgels_,:zgesv_,:zgetrs_,:zgetri_,:ComplexF64),
930 (:cgels_,:cgesv_,:cgetrs_,:cgetri_,:ComplexF32))
931 @eval begin
932 # SUBROUTINE DGELS( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,INFO)
933 # * .. Scalar Arguments ..
934 # CHARACTER TRANS
935 # INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
936 function gels!(trans::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
937 require_one_based_indexing(A, B)
938 chktrans(trans)
939 chkstride1(A, B)
940 btrn = trans == 'T'
941 m, n = size(A)
942 if size(B,1) != (btrn ? n : m)
943 throw(DimensionMismatch("matrix A has dimensions ($m,$n), transposed: $btrn, but leading dimension of B is $(size(B,1))"))
944 end
945 info = Ref{BlasInt}()
946 work = Vector{$elty}(undef, 1)
947 lwork = BlasInt(-1)
948 for i = 1:2 # first call returns lwork as work[1]
949 ccall((@blasfunc($gels), libblastrampoline), Cvoid,
950 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
951 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
952 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
953 (btrn ? 'T' : 'N'), m, n, size(B,2), A, max(1,stride(A,2)),
954 B, max(1,stride(B,2)), work, lwork, info, 1)
955 chklapackerror(info[])
956 if i == 1
957 lwork = BlasInt(real(work[1]))
958 resize!(work, lwork)
959 end
960 end
961 k = min(m, n)
962 F = m < n ? tril(A[1:k, 1:k]) : triu(A[1:k, 1:k])
963 ssr = Vector{$elty}(undef, size(B, 2))
964 for i = 1:size(B,2)
965 x = zero($elty)
966 for j = k+1:size(B,1)
967 x += abs2(B[j,i])
968 end
969 ssr[i] = x
970 end
971 F, subsetrows(B, B, k), ssr
972 end
973
974 # SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
975 # * .. Scalar Arguments ..
976 # INTEGER INFO, LDA, LDB, N, NRHS
977 # * ..
978 # * .. Array Arguments ..
979 # INTEGER IPIV( * )
980 # DOUBLE PRECISION A( LDA, * ), B( LDB, * )
981 function gesv!(A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
982 require_one_based_indexing(A, B)
983 chkstride1(A, B)
984 n = checksquare(A)
985 if size(B,1) != n
986 throw(DimensionMismatch("B has leading dimension $(size(B,1)), but needs $n"))
987 end
988 ipiv = similar(A, BlasInt, n)
989 info = Ref{BlasInt}()
990 ccall((@blasfunc($gesv), libblastrampoline), Cvoid,
991 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
992 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
993 n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info)
994 chklapackerror(info[])
995 B, A, ipiv
996 end
997
998 # SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
999 #* .. Scalar Arguments ..
1000 # CHARACTER TRANS
1001 # INTEGER INFO, LDA, LDB, N, NRHS
1002 # .. Array Arguments ..
1003 # INTEGER IPIV( * )
1004 # DOUBLE PRECISION A( LDA, * ), B( LDB, * )
1005
9 (3 %) samples spent in getrs!
9 (100 %) (ex.), 9 (100 %) (incl.) when called from ldiv! line 425
function getrs!(trans::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat{$elty})
1006 require_one_based_indexing(A, ipiv, B)
1007 chktrans(trans)
1008 chkstride1(A, B, ipiv)
1009 n = checksquare(A)
1010 if n != size(B, 1)
1011 throw(DimensionMismatch("B has leading dimension $(size(B,1)), but needs $n"))
1012 end
1013 if n != length(ipiv)
1014 throw(DimensionMismatch("ipiv has length $(length(ipiv)), but needs to be $n"))
1015 end
1016 nrhs = size(B, 2)
1017 info = Ref{BlasInt}()
1018 9 (3 %) 9 (3 %) ccall((@blasfunc($getrs), libblastrampoline), Cvoid,
1019 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1020 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
1021 trans, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info, 1)
1022 chklapackerror(info[])
1023 B
1024 end
1025
1026 # SUBROUTINE DGETRI( N, A, LDA, IPIV, WORK, LWORK, INFO )
1027 #* .. Scalar Arguments ..
1028 # INTEGER INFO, LDA, LWORK, N
1029 #* .. Array Arguments ..
1030 # INTEGER IPIV( * )
1031 # DOUBLE PRECISION A( LDA, * ), WORK( * )
1032 function getri!(A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
1033 require_one_based_indexing(A, ipiv)
1034 chkstride1(A, ipiv)
1035 n = checksquare(A)
1036 if n != length(ipiv)
1037 throw(DimensionMismatch("ipiv has length $(length(ipiv)), but needs $n"))
1038 end
1039 lda = max(1,stride(A, 2))
1040 lwork = BlasInt(-1)
1041 work = Vector{$elty}(undef, 1)
1042 info = Ref{BlasInt}()
1043 for i = 1:2 # first call returns lwork as work[1]
1044 ccall((@blasfunc($getri), libblastrampoline), Cvoid,
1045 (Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
1046 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
1047 n, A, lda, ipiv, work, lwork, info)
1048 chklapackerror(info[])
1049 if i == 1
1050 lwork = BlasInt(real(work[1]))
1051 resize!(work, lwork)
1052 end
1053 end
1054 A
1055 end
1056 end
1057 end
1058
1059 """
1060 gels!(trans, A, B) -> (F, B, ssr)
1061
1062 Solves the linear equation `A * X = B`, `transpose(A) * X = B`, or `adjoint(A) * X = B` using
1063 a QR or LQ factorization. Modifies the matrix/vector `B` in place with the
1064 solution. `A` is overwritten with its `QR` or `LQ` factorization. `trans`
1065 may be one of `N` (no modification), `T` (transpose), or `C` (conjugate
1066 transpose). `gels!` searches for the minimum norm/least squares solution.
1067 `A` may be under or over determined. The solution is returned in `B`.
1068 """
1069 gels!(trans::AbstractChar, A::AbstractMatrix, B::AbstractVecOrMat)
1070
1071 """
1072 gesv!(A, B) -> (B, A, ipiv)
1073
1074 Solves the linear equation `A * X = B` where `A` is a square matrix using
1075 the `LU` factorization of `A`. `A` is overwritten with its `LU`
1076 factorization and `B` is overwritten with the solution `X`. `ipiv` contains the
1077 pivoting information for the `LU` factorization of `A`.
1078 """
1079 gesv!(A::AbstractMatrix, B::AbstractVecOrMat)
1080
1081 """
1082 getrs!(trans, A, ipiv, B)
1083
1084 Solves the linear equation `A * X = B`, `transpose(A) * X = B`, or `adjoint(A) * X = B` for
1085 square `A`. Modifies the matrix/vector `B` in place with the solution. `A`
1086 is the `LU` factorization from `getrf!`, with `ipiv` the pivoting
1087 information. `trans` may be one of `N` (no modification), `T` (transpose),
1088 or `C` (conjugate transpose).
1089 """
1090 getrs!(trans::AbstractChar, A::AbstractMatrix, ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat)
1091
1092 """
1093 getri!(A, ipiv)
1094
1095 Computes the inverse of `A`, using its `LU` factorization found by
1096 `getrf!`. `ipiv` is the pivot information output and `A`
1097 contains the `LU` factorization of `getrf!`. `A` is overwritten with
1098 its inverse.
1099 """
1100 getri!(A::AbstractMatrix, ipiv::AbstractVector{BlasInt})
1101
1102 for (gesvx, elty) in
1103 ((:dgesvx_,:Float64),
1104 (:sgesvx_,:Float32))
1105 @eval begin
1106 # SUBROUTINE DGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
1107 # EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
1108 # WORK, IWORK, INFO )
1109 #
1110 # .. Scalar Arguments ..
1111 # CHARACTER EQUED, FACT, TRANS
1112 # INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
1113 # DOUBLE PRECISION RCOND
1114 # ..
1115 # .. Array Arguments ..
1116 # INTEGER IPIV( * ), IWORK( * )
1117 # DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
1118 # $ BERR( * ), C( * ), FERR( * ), R( * ),
1119 # $ WORK( * ), X( LDX, *
1120 #
1121 function gesvx!(fact::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
1122 AF::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt}, equed::AbstractChar,
1123 R::AbstractVector{$elty}, C::AbstractVector{$elty}, B::AbstractVecOrMat{$elty})
1124 require_one_based_indexing(A, AF, ipiv, R, C, B)
1125 chktrans(trans)
1126 chkstride1(ipiv, R, C, B)
1127 n = checksquare(A)
1128 lda = stride(A,2)
1129 n = checksquare(AF)
1130 ldaf = stride(AF,2)
1131 nrhs = size(B,2)
1132 ldb = stride(B,2)
1133 rcond = Ref{$elty}()
1134 ferr = similar(A, $elty, nrhs)
1135 berr = similar(A, $elty, nrhs)
1136 work = Vector{$elty}(undef, 4n)
1137 iwork = Vector{BlasInt}(undef, n)
1138 info = Ref{BlasInt}()
1139 X = similar(A, $elty, n, nrhs)
1140 ccall((@blasfunc($gesvx), libblastrampoline), Cvoid,
1141 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
1142 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
1143 Ref{UInt8}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
1144 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
1145 Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Clong, Clong, Clong),
1146 fact, trans, n, nrhs, A, lda, AF, ldaf, ipiv, equed, R, C, B,
1147 ldb, X, n, rcond, ferr, berr, work, iwork, info, 1, 1, 1)
1148 chklapackerror(info[])
1149 if info[] == n + 1
1150 @warn "Matrix is singular to working precision"
1151 else
1152 chknonsingular(info[])
1153 end
1154 #WORK(1) contains the reciprocal pivot growth factor norm(A)/norm(U)
1155 X, equed, R, C, B, rcond[], ferr, berr, work[1]
1156 end
1157
1158 function gesvx!(A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
1159 n = size(A,1)
1160 X, equed, R, C, B, rcond, ferr, berr, rpgf =
1161 gesvx!('N', 'N', A,
1162 similar(A, $elty, n, n),
1163 similar(A, BlasInt, n),
1164 'N',
1165 similar(A, $elty, n),
1166 similar(A, $elty, n),
1167 B)
1168 X, rcond, ferr, berr, rpgf
1169 end
1170 end
1171 end
1172 for (gesvx, elty, relty) in
1173 ((:zgesvx_,:ComplexF64,:Float64),
1174 (:cgesvx_,:ComplexF32 ,:Float32))
1175 @eval begin
1176 # SUBROUTINE ZGESVX( FACT, TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV,
1177 # EQUED, R, C, B, LDB, X, LDX, RCOND, FERR, BERR,
1178 # WORK, RWORK, INFO )
1179 #
1180 # .. Scalar Arguments ..
1181 # CHARACTER EQUED, FACT, TRANS
1182 # INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
1183 # DOUBLE PRECISION RCOND
1184 # ..
1185 # .. Array Arguments ..
1186 # INTEGER IPIV( * )
1187 # DOUBLE PRECISION BERR( * ), C( * ), FERR( * ), R( * ),
1188 # $ RWORK( * )
1189 # COMPLEX*16 A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
1190 # $ WORK( * ), X( LDX, * )
1191 function gesvx!(fact::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
1192 AF::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt}, equed::AbstractChar,
1193 R::AbstractVector{$relty}, C::AbstractVector{$relty}, B::AbstractVecOrMat{$elty})
1194 require_one_based_indexing(A, AF, ipiv, R, C, B)
1195 chktrans(trans)
1196 chkstride1(A, AF, ipiv, R, C, B)
1197 n = checksquare(A)
1198 lda = stride(A,2)
1199 n = checksquare(AF)
1200 ldaf = stride(AF,2)
1201 nrhs = size(B,2)
1202 ldb = stride(B,2)
1203 rcond = Ref{$relty}()
1204 ferr = similar(A, $relty, nrhs)
1205 berr = similar(A, $relty, nrhs)
1206 work = Vector{$elty}(undef, 2n)
1207 rwork = Vector{$relty}(undef, 2n)
1208 info = Ref{BlasInt}()
1209 X = similar(A, $elty, n, nrhs)
1210 ccall((@blasfunc($gesvx), libblastrampoline), Cvoid,
1211 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
1212 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
1213 Ref{UInt8}, Ptr{$relty}, Ptr{$relty}, Ptr{$elty}, Ref{BlasInt},
1214 Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ptr{$relty}, Ptr{$relty},
1215 Ptr{$elty}, Ptr{$relty}, Ptr{BlasInt}, Clong, Clong, Clong),
1216 fact, trans, n, nrhs, A, lda, AF, ldaf, ipiv, equed, R, C, B,
1217 ldb, X, n, rcond, ferr, berr, work, rwork, info, 1, 1, 1)
1218 chklapackerror(info[])
1219 if info[] == n + 1
1220 @warn "Matrix is singular to working precision"
1221 else
1222 chknonsingular(info[])
1223 end
1224 #RWORK(1) contains the reciprocal pivot growth factor norm(A)/norm(U)
1225 X, equed, R, C, B, rcond[], ferr, berr, rwork[1]
1226 end
1227
1228 #Wrapper for the no-equilibration, no-transpose calculation
1229 function gesvx!(A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
1230 n = size(A,1)
1231 X, equed, R, C, B, rcond, ferr, berr, rpgf =
1232 gesvx!('N', 'N', A,
1233 similar(A, $elty, n, n),
1234 similar(A, BlasInt, n),
1235 'N',
1236 similar(A, $relty, n),
1237 similar(A, $relty, n),
1238 B)
1239 X, rcond, ferr, berr, rpgf
1240 end
1241 end
1242 end
1243
1244 """
1245 gesvx!(fact, trans, A, AF, ipiv, equed, R, C, B) -> (X, equed, R, C, B, rcond, ferr, berr, work)
1246
1247 Solves the linear equation `A * X = B` (`trans = N`), `transpose(A) * X = B`
1248 (`trans = T`), or `adjoint(A) * X = B` (`trans = C`) using the `LU` factorization
1249 of `A`. `fact` may be `E`, in which case `A` will be equilibrated and copied
1250 to `AF`; `F`, in which case `AF` and `ipiv` from a previous `LU` factorization
1251 are inputs; or `N`, in which case `A` will be copied to `AF` and then
1252 factored. If `fact = F`, `equed` may be `N`, meaning `A` has not been
1253 equilibrated; `R`, meaning `A` was multiplied by `Diagonal(R)` from the left;
1254 `C`, meaning `A` was multiplied by `Diagonal(C)` from the right; or `B`, meaning
1255 `A` was multiplied by `Diagonal(R)` from the left and `Diagonal(C)` from the right.
1256 If `fact = F` and `equed = R` or `B` the elements of `R` must all be positive.
1257 If `fact = F` and `equed = C` or `B` the elements of `C` must all be positive.
1258
1259 Returns the solution `X`; `equed`, which is an output if `fact` is not `N`,
1260 and describes the equilibration that was performed; `R`, the row equilibration
1261 diagonal; `C`, the column equilibration diagonal; `B`, which may be overwritten
1262 with its equilibrated form `Diagonal(R)*B` (if `trans = N` and `equed = R,B`) or
1263 `Diagonal(C)*B` (if `trans = T,C` and `equed = C,B`); `rcond`, the reciprocal
1264 condition number of `A` after equilbrating; `ferr`, the forward error bound for
1265 each solution vector in `X`; `berr`, the forward error bound for each solution
1266 vector in `X`; and `work`, the reciprocal pivot growth factor.
1267 """
1268 gesvx!(fact::AbstractChar, trans::AbstractChar, A::AbstractMatrix, AF::AbstractMatrix,
1269 ipiv::AbstractVector{BlasInt}, equed::AbstractChar, R::AbstractVector, C::AbstractVector, B::AbstractVecOrMat)
1270
1271 """
1272 gesvx!(A, B)
1273
1274 The no-equilibration, no-transpose simplification of `gesvx!`.
1275 """
1276 gesvx!(A::AbstractMatrix, B::AbstractVecOrMat)
1277
1278 for (gelsd, gelsy, elty) in
1279 ((:dgelsd_,:dgelsy_,:Float64),
1280 (:sgelsd_,:sgelsy_,:Float32))
1281 @eval begin
1282 # SUBROUTINE DGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
1283 # $ WORK, LWORK, IWORK, INFO )
1284 # * .. Scalar Arguments ..
1285 # INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
1286 # DOUBLE PRECISION RCOND
1287 # * ..
1288 # * .. Array Arguments ..
1289 # INTEGER IWORK( * )
1290 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), S( * ), WORK( * )
1291 function gelsd!(A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty}, rcond::Real=-one($elty))
1292 require_one_based_indexing(A, B)
1293 chkstride1(A, B)
1294 m, n = size(A)
1295 if size(B, 1) != m
1296 throw(DimensionMismatch("B has leading dimension $(size(B,1)) but needs $m"))
1297 end
1298 newB = [B; zeros($elty, max(0, n - size(B, 1)), size(B, 2))]
1299 s = similar(A, $elty, min(m, n))
1300 rnk = Ref{BlasInt}()
1301 info = Ref{BlasInt}()
1302 work = Vector{$elty}(undef, 1)
1303 lwork = BlasInt(-1)
1304 iwork = Vector{BlasInt}(undef, 1)
1305 for i = 1:2 # first call returns lwork as work[1] and iwork length as iwork[1]
1306 ccall((@blasfunc($gelsd), libblastrampoline), Cvoid,
1307 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
1308 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1309 Ptr{$elty}, Ref{$elty}, Ref{BlasInt}, Ptr{$elty},
1310 Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}),
1311 m, n, size(B,2),
1312 A, max(1,stride(A,2)), newB, max(1,stride(B,2),n),
1313 s, $elty(rcond), rnk, work,
1314 lwork, iwork, info)
1315 chklapackerror(info[])
1316 if i == 1
1317 lwork = BlasInt(real(work[1]))
1318 resize!(work, lwork)
1319 resize!(iwork, iwork[1])
1320 end
1321 end
1322 subsetrows(B, newB, n), rnk[]
1323 end
1324
1325 # SUBROUTINE DGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
1326 # $ WORK, LWORK, INFO )
1327 # * .. Scalar Arguments ..
1328 # INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
1329 # DOUBLE PRECISION RCOND
1330 # * ..
1331 # * .. Array Arguments ..
1332 # INTEGER JPVT( * )
1333 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
1334 function gelsy!(A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty}, rcond::Real=eps($elty))
1335 require_one_based_indexing(A, B)
1336 chkstride1(A)
1337 m = size(A, 1)
1338 n = size(A, 2)
1339 nrhs = size(B, 2)
1340 if size(B, 1) != m
1341 throw(DimensionMismatch("B has leading dimension $(size(B,1)) but needs $m"))
1342 end
1343 newB = [B; zeros($elty, max(0, n - size(B, 1)), size(B, 2))]
1344 lda = max(1, stride(A,2))
1345 ldb = max(1, stride(newB,2))
1346 jpvt = zeros(BlasInt, n)
1347 rnk = Ref{BlasInt}()
1348 work = Vector{$elty}(undef, 1)
1349 lwork = BlasInt(-1)
1350 info = Ref{BlasInt}()
1351 for i = 1:2 # first call returns lwork as work[1]
1352 ccall((@blasfunc($gelsy), libblastrampoline), Cvoid,
1353 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
1354 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
1355 Ref{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1356 Ptr{BlasInt}),
1357 m, n, nrhs, A,
1358 lda, newB, ldb, jpvt,
1359 $elty(rcond), rnk, work, lwork,
1360 info)
1361 chklapackerror(info[])
1362 if i == 1
1363 lwork = BlasInt(work[1])
1364 resize!(work, lwork)
1365 end
1366 end
1367 subsetrows(B, newB, n), rnk[]
1368 end
1369 end
1370 end
1371
1372 for (gelsd, gelsy, elty, relty) in
1373 ((:zgelsd_,:zgelsy_,:ComplexF64,:Float64),
1374 (:cgelsd_,:cgelsy_,:ComplexF32,:Float32))
1375 @eval begin
1376 # SUBROUTINE ZGELSD( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
1377 # $ WORK, LWORK, RWORK, IWORK, INFO )
1378 # * .. Scalar Arguments ..
1379 # INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
1380 # DOUBLE PRECISION RCOND
1381 # * ..
1382 # * .. Array Arguments ..
1383 # INTEGER IWORK( * )
1384 # DOUBLE PRECISION RWORK( * ), S( * )
1385 # COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
1386 function gelsd!(A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty}, rcond::Real=-one($relty))
1387 require_one_based_indexing(A, B)
1388 chkstride1(A, B)
1389 m, n = size(A)
1390 if size(B, 1) != m
1391 throw(DimensionMismatch("B has leading dimension $(size(B,1)) but needs $m"))
1392 end
1393 newB = [B; zeros($elty, max(0, n - size(B, 1)), size(B, 2))]
1394 s = similar(A, $relty, min(m, n))
1395 rnk = Ref{BlasInt}()
1396 info = Ref{BlasInt}()
1397 work = Vector{$elty}(undef, 1)
1398 lwork = BlasInt(-1)
1399 rwork = Vector{$relty}(undef, 1)
1400 iwork = Vector{BlasInt}(undef, 1)
1401 for i = 1:2 # first call returns lwork as work[1], rwork length as rwork[1] and iwork length as iwork[1]
1402 ccall((@blasfunc($gelsd), libblastrampoline), Cvoid,
1403 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
1404 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$relty},
1405 Ref{$relty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1406 Ptr{$relty}, Ref{BlasInt}, Ref{BlasInt}),
1407 m, n, size(B,2), A,
1408 max(1,stride(A,2)), newB, max(1,stride(B,2),n), s,
1409 $relty(rcond), rnk, work, lwork,
1410 rwork, iwork, info)
1411 chklapackerror(info[])
1412 if i == 1
1413 lwork = BlasInt(real(work[1]))
1414 resize!(work, lwork)
1415 resize!(rwork, BlasInt(rwork[1]))
1416 resize!(iwork, iwork[1])
1417 end
1418 end
1419 subsetrows(B, newB, n), rnk[]
1420 end
1421
1422 # SUBROUTINE ZGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
1423 # $ WORK, LWORK, RWORK, INFO )
1424 # * .. Scalar Arguments ..
1425 # INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
1426 # DOUBLE PRECISION RCOND
1427 # * ..
1428 # * .. Array Arguments ..
1429 # INTEGER JPVT( * )
1430 # DOUBLE PRECISION RWORK( * )
1431 # COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
1432 function gelsy!(A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty}, rcond::Real=eps($relty))
1433 require_one_based_indexing(A, B)
1434 chkstride1(A, B)
1435 m, n = size(A)
1436 nrhs = size(B, 2)
1437 if size(B, 1) != m
1438 throw(DimensionMismatch("B has leading dimension $(size(B,1)) but needs $m"))
1439 end
1440 newB = [B; zeros($elty, max(0, n - size(B, 1)), size(B, 2))]
1441 lda = max(1, m)
1442 ldb = max(1, m, n)
1443 jpvt = zeros(BlasInt, n)
1444 rnk = Ref{BlasInt}(1)
1445 work = Vector{$elty}(undef, 1)
1446 lwork = BlasInt(-1)
1447 rwork = Vector{$relty}(undef, 2n)
1448 info = Ref{BlasInt}()
1449 for i = 1:2 # first call returns lwork as work[1]
1450 ccall((@blasfunc($gelsy), libblastrampoline), Cvoid,
1451 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
1452 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
1453 Ref{$relty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1454 Ptr{$relty}, Ptr{BlasInt}),
1455 m, n, nrhs, A,
1456 lda, newB, ldb, jpvt,
1457 $relty(rcond), rnk, work, lwork,
1458 rwork, info)
1459 chklapackerror(info[])
1460 if i == 1
1461 lwork = BlasInt(real(work[1]))
1462 resize!(work, lwork)
1463 end
1464 end
1465 subsetrows(B, newB, n), rnk[]
1466 end
1467 end
1468 end
1469
1470 """
1471 gelsd!(A, B, rcond) -> (B, rnk)
1472
1473 Computes the least norm solution of `A * X = B` by finding the `SVD`
1474 factorization of `A`, then dividing-and-conquering the problem. `B`
1475 is overwritten with the solution `X`. Singular values below `rcond`
1476 will be treated as zero. Returns the solution in `B` and the effective rank
1477 of `A` in `rnk`.
1478 """
1479 gelsd!(A::AbstractMatrix, B::AbstractVecOrMat, rcond::Real)
1480
1481 """
1482 gelsy!(A, B, rcond) -> (B, rnk)
1483
1484 Computes the least norm solution of `A * X = B` by finding the full `QR`
1485 factorization of `A`, then dividing-and-conquering the problem. `B`
1486 is overwritten with the solution `X`. Singular values below `rcond`
1487 will be treated as zero. Returns the solution in `B` and the effective rank
1488 of `A` in `rnk`.
1489 """
1490 gelsy!(A::AbstractMatrix, B::AbstractVecOrMat, rcond::Real)
1491
1492 for (gglse, elty) in ((:dgglse_, :Float64),
1493 (:sgglse_, :Float32),
1494 (:zgglse_, :ComplexF64),
1495 (:cgglse_, :ComplexF32))
1496 @eval begin
1497 # SUBROUTINE DGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
1498 # $ INFO )
1499 # * .. Scalar Arguments ..
1500 # INTEGER INFO, LDA, LDB, LWORK, M, N, P
1501 # * ..
1502 # * .. Array Arguments ..
1503 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), C( * ), D( * ),
1504 # $ WORK( * ), X( * )
1505 function gglse!(A::AbstractMatrix{$elty}, c::AbstractVector{$elty},
1506 B::AbstractMatrix{$elty}, d::AbstractVector{$elty})
1507 require_one_based_indexing(A, c, B, d)
1508 chkstride1(A, c, B, d)
1509 m, n = size(A)
1510 p = size(B, 1)
1511 if size(B, 2) != n
1512 throw(DimensionMismatch("B has second dimension $(size(B,2)), needs $n"))
1513 end
1514 if length(c) != m
1515 throw(DimensionMismatch("c has length $(length(c)), needs $m"))
1516 end
1517 if length(d) != p
1518 throw(DimensionMismatch("d has length $(length(d)), needs $p"))
1519 end
1520 X = zeros($elty, n)
1521 info = Ref{BlasInt}()
1522 work = Vector{$elty}(undef, 1)
1523 lwork = BlasInt(-1)
1524 for i = 1:2 # first call returns lwork as work[1]
1525 ccall((@blasfunc($gglse), libblastrampoline), Cvoid,
1526 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
1527 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
1528 Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
1529 Ptr{BlasInt}),
1530 m, n, p, A, max(1,stride(A,2)), B, max(1,stride(B,2)), c, d, X,
1531 work, lwork, info)
1532 chklapackerror(info[])
1533 if i == 1
1534 lwork = BlasInt(real(work[1]))
1535 resize!(work, lwork)
1536 end
1537 end
1538 X, dot(view(c, n - p + 1:m), view(c, n - p + 1:m))
1539 end
1540 end
1541 end
1542
1543 """
1544 gglse!(A, c, B, d) -> (X,res)
1545
1546 Solves the equation `A * x = c` where `x` is subject to the equality
1547 constraint `B * x = d`. Uses the formula `||c - A*x||^2 = 0` to solve.
1548 Returns `X` and the residual sum-of-squares.
1549 """
1550 gglse!(A::AbstractMatrix, c::AbstractVector, B::AbstractMatrix, d::AbstractVector)
1551
1552 # (GE) general matrices eigenvalue-eigenvector and singular value decompositions
1553 for (geev, gesvd, gesdd, ggsvd, elty, relty) in
1554 ((:dgeev_,:dgesvd_,:dgesdd_,:dggsvd_,:Float64,:Float64),
1555 (:sgeev_,:sgesvd_,:sgesdd_,:sggsvd_,:Float32,:Float32),
1556 (:zgeev_,:zgesvd_,:zgesdd_,:zggsvd_,:ComplexF64,:Float64),
1557 (:cgeev_,:cgesvd_,:cgesdd_,:cggsvd_,:ComplexF32,:Float32))
1558 @eval begin
1559 # SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR,
1560 # $ LDVR, WORK, LWORK, INFO )
1561 # * .. Scalar Arguments ..
1562 # CHARACTER JOBVL, JOBVR
1563 # INTEGER INFO, LDA, LDVL, LDVR, LWORK, N
1564 # * .. Array Arguments ..
1565 # DOUBLE PRECISION A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
1566 # $ WI( * ), WORK( * ), WR( * )
1567 function geev!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix{$elty})
1568 chkstride1(A)
1569 n = checksquare(A)
1570 chkfinite(A) # balancing routines don't support NaNs and Infs
1571 lvecs = jobvl == 'V'
1572 rvecs = jobvr == 'V'
1573 VL = similar(A, $elty, (n, lvecs ? n : 0))
1574 VR = similar(A, $elty, (n, rvecs ? n : 0))
1575 cmplx = eltype(A) <: Complex
1576 if cmplx
1577 W = similar(A, $elty, n)
1578 rwork = similar(A, $relty, 2n)
1579 else
1580 WR = similar(A, $elty, n)
1581 WI = similar(A, $elty, n)
1582 end
1583 work = Vector{$elty}(undef, 1)
1584 lwork = BlasInt(-1)
1585 info = Ref{BlasInt}()
1586 for i = 1:2 # first call returns lwork as work[1]
1587 if cmplx
1588 ccall((@blasfunc($geev), libblastrampoline), Cvoid,
1589 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
1590 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
1591 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1592 Ptr{$relty}, Ptr{BlasInt}, Clong, Clong),
1593 jobvl, jobvr, n, A, max(1,stride(A,2)), W, VL, n, VR, n,
1594 work, lwork, rwork, info, 1, 1)
1595 else
1596 ccall((@blasfunc($geev), libblastrampoline), Cvoid,
1597 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
1598 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
1599 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
1600 Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
1601 jobvl, jobvr, n, A, max(1,stride(A,2)), WR, WI, VL, n,
1602 VR, n, work, lwork, info, 1, 1)
1603 end
1604 chklapackerror(info[])
1605 if i == 1
1606 lwork = BlasInt(real(work[1]))
1607 resize!(work, lwork)
1608 end
1609 end
1610 cmplx ? (W, VL, VR) : (WR, WI, VL, VR)
1611 end
1612
1613 # SUBROUTINE DGESDD( JOBZ, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK,
1614 # LWORK, IWORK, INFO )
1615 #* .. Scalar Arguments ..
1616 # CHARACTER JOBZ
1617 # INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
1618 #* ..
1619 #* .. Array Arguments ..
1620 # INTEGER IWORK( * )
1621 # DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
1622 # VT( LDVT, * ), WORK( * )
1623 function gesdd!(job::AbstractChar, A::AbstractMatrix{$elty})
1624 require_one_based_indexing(A)
1625 chkstride1(A)
1626 m, n = size(A)
1627 minmn = min(m, n)
1628 if job == 'A'
1629 U = similar(A, $elty, (m, m))
1630 VT = similar(A, $elty, (n, n))
1631 elseif job == 'S'
1632 U = similar(A, $elty, (m, minmn))
1633 VT = similar(A, $elty, (minmn, n))
1634 elseif job == 'O'
1635 U = similar(A, $elty, (m, m >= n ? 0 : m))
1636 VT = similar(A, $elty, (n, m >= n ? n : 0))
1637 else
1638 U = similar(A, $elty, (m, 0))
1639 VT = similar(A, $elty, (n, 0))
1640 end
1641 work = Vector{$elty}(undef, 1)
1642 lwork = BlasInt(-1)
1643 S = similar(A, $relty, minmn)
1644 cmplx = eltype(A)<:Complex
1645 if cmplx
1646 rwork = Vector{$relty}(undef, job == 'N' ? 7*minmn : minmn*max(5*minmn+7, 2*max(m,n)+2*minmn+1))
1647 end
1648 iwork = Vector{BlasInt}(undef, 8*minmn)
1649 info = Ref{BlasInt}()
1650 for i = 1:2 # first call returns lwork as work[1]
1651 if cmplx
1652 ccall((@blasfunc($gesdd), libblastrampoline), Cvoid,
1653 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
1654 Ref{BlasInt}, Ptr{$relty}, Ptr{$elty}, Ref{BlasInt},
1655 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1656 Ptr{$relty}, Ptr{BlasInt}, Ptr{BlasInt}, Clong),
1657 job, m, n, A, max(1,stride(A,2)), S, U, max(1,stride(U,2)), VT, max(1,stride(VT,2)),
1658 work, lwork, rwork, iwork, info, 1)
1659 else
1660 ccall((@blasfunc($gesdd), libblastrampoline), Cvoid,
1661 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
1662 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
1663 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1664 Ptr{BlasInt}, Ptr{BlasInt}, Clong),
1665 job, m, n, A, max(1,stride(A,2)), S, U, max(1,stride(U,2)), VT, max(1,stride(VT,2)),
1666 work, lwork, iwork, info, 1)
1667 end
1668 chklapackerror(info[])
1669 if i == 1
1670 # Work around issue with truncated Float32 representation of lwork in
1671 # sgesdd by using nextfloat. See
1672 # http://icl.cs.utk.edu/lapack-forum/viewtopic.php?f=13&t=4587&p=11036&hilit=sgesdd#p11036
1673 # and
1674 # https://github.com/scipy/scipy/issues/5401
1675 lwork = round(BlasInt, nextfloat(real(work[1])))
1676 resize!(work, lwork)
1677 end
1678 end
1679 if job == 'O'
1680 if m >= n
1681 return (A, S, VT)
1682 else
1683 # ()__
1684 # ||::Z__
1685 # ||::|:::Z____
1686 # ||::|:::|====|
1687 # ||==|===|====|
1688 # ||""|===|====|
1689 # || `"""|====|
1690 # || `""""`
1691 return (U, S, A)
1692 end
1693 end
1694 return (U, S, VT)
1695 end
1696
1697 # SUBROUTINE DGESVD( JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO )
1698 # * .. Scalar Arguments ..
1699 # CHARACTER JOBU, JOBVT
1700 # INTEGER INFO, LDA, LDU, LDVT, LWORK, M, N
1701 # * .. Array Arguments ..
1702 # DOUBLE PRECISION A( LDA, * ), S( * ), U( LDU, * ),
1703 # $ VT( LDVT, * ), WORK( * )
1704 function gesvd!(jobu::AbstractChar, jobvt::AbstractChar, A::AbstractMatrix{$elty})
1705 require_one_based_indexing(A)
1706 chkstride1(A)
1707 m, n = size(A)
1708 minmn = min(m, n)
1709 S = similar(A, $relty, minmn)
1710 U = similar(A, $elty, jobu == 'A' ? (m, m) : (jobu == 'S' ? (m, minmn) : (m, 0)))
1711 VT = similar(A, $elty, jobvt == 'A' ? (n, n) : (jobvt == 'S' ? (minmn, n) : (n, 0)))
1712 work = Vector{$elty}(undef, 1)
1713 cmplx = eltype(A) <: Complex
1714 if cmplx
1715 rwork = Vector{$relty}(undef, 5minmn)
1716 end
1717 lwork = BlasInt(-1)
1718 info = Ref{BlasInt}()
1719 for i in 1:2 # first call returns lwork as work[1]
1720 if cmplx
1721 ccall((@blasfunc($gesvd), libblastrampoline), Cvoid,
1722 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
1723 Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ptr{$elty},
1724 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
1725 Ref{BlasInt}, Ptr{$relty}, Ptr{BlasInt}, Clong, Clong),
1726 jobu, jobvt, m, n, A, max(1,stride(A,2)), S, U, max(1,stride(U,2)), VT, max(1,stride(VT,2)),
1727 work, lwork, rwork, info, 1, 1)
1728 else
1729 ccall((@blasfunc($gesvd), libblastrampoline), Cvoid,
1730 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
1731 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
1732 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
1733 Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
1734 jobu, jobvt, m, n, A, max(1,stride(A,2)), S, U, max(1,stride(U,2)), VT, max(1,stride(VT,2)),
1735 work, lwork, info, 1, 1)
1736 end
1737 chklapackerror(info[])
1738 if i == 1
1739 lwork = BlasInt(real(work[1]))
1740 resize!(work, lwork)
1741 end
1742 end
1743 if jobu == 'O'
1744 return (A, S, VT)
1745 elseif jobvt == 'O'
1746 # =============|===========|()
1747 # # # #::::::
1748 # # # #::::::
1749 # # # #::::::
1750 # # # #::::::
1751 # # # # # # #
1752 # # # # # # #
1753 # # # # # # #
1754 return (U, S, A) # # # # # # #
1755 else # # # # # # #
1756 return (U, S, VT) # # # # # # #
1757
1758 end
1759 end
1760
1761 # SUBROUTINE ZGGSVD( JOBU, JOBV, JOBQ, M, N, P, K, L, A, LDA, B,
1762 # $ LDB, ALPHA, BETA, U, LDU, V, LDV, Q, LDQ, WORK,
1763 # $ RWORK, IWORK, INFO )
1764 # * .. Scalar Arguments ..
1765 # CHARACTER JOBQ, JOBU, JOBV
1766 # INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P
1767 # * ..
1768 # * .. Array Arguments ..
1769 # INTEGER IWORK( * )
1770 # DOUBLE PRECISION ALPHA( * ), BETA( * ), RWORK( * )
1771 # COMPLEX*16 A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
1772 # $ U( LDU, * ), V( LDV, * ), WORK( * )
1773 function ggsvd!(jobu::AbstractChar, jobv::AbstractChar, jobq::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
1774 require_one_based_indexing(A, B)
1775 chkstride1(A, B)
1776 m, n = size(A)
1777 if size(B, 2) != n
1778 throw(DimensionMismatch("B has second dimension $(size(B,2)) but needs $n"))
1779 end
1780 p = size(B, 1)
1781 k = Vector{BlasInt}(undef, 1)
1782 l = Vector{BlasInt}(undef, 1)
1783 lda = max(1,stride(A, 2))
1784 ldb = max(1,stride(B, 2))
1785 alpha = similar(A, $relty, n)
1786 beta = similar(A, $relty, n)
1787 ldu = max(1, m)
1788 U = jobu == 'U' ? similar(A, $elty, ldu, m) : similar(A, $elty, 0)
1789 ldv = max(1, p)
1790 V = jobv == 'V' ? similar(A, $elty, ldv, p) : similar(A, $elty, 0)
1791 ldq = max(1, n)
1792 Q = jobq == 'Q' ? similar(A, $elty, ldq, n) : similar(A, $elty, 0)
1793 work = Vector{$elty}(undef, max(3n, m, p) + n)
1794 cmplx = eltype(A) <: Complex
1795 if cmplx
1796 rwork = Vector{$relty}(undef, 2n)
1797 end
1798 iwork = Vector{BlasInt}(undef, n)
1799 info = Ref{BlasInt}()
1800 if cmplx
1801 ccall((@blasfunc($ggsvd), libblastrampoline), Cvoid,
1802 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
1803 Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt},
1804 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1805 Ptr{$relty}, Ptr{$relty}, Ptr{$elty}, Ref{BlasInt},
1806 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1807 Ptr{$elty}, Ptr{$relty}, Ptr{BlasInt}, Ptr{BlasInt},
1808 Clong, Clong, Clong),
1809 jobu, jobv, jobq, m,
1810 n, p, k, l,
1811 A, lda, B, ldb,
1812 alpha, beta, U, ldu,
1813 V, ldv, Q, ldq,
1814 work, rwork, iwork, info,
1815 1, 1, 1)
1816 else
1817 ccall((@blasfunc($ggsvd), libblastrampoline), Cvoid,
1818 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
1819 Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt},
1820 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1821 Ptr{$relty}, Ptr{$relty}, Ptr{$elty}, Ref{BlasInt},
1822 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1823 Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt},
1824 Clong, Clong, Clong),
1825 jobu, jobv, jobq, m,
1826 n, p, k, l,
1827 A, lda, B, ldb,
1828 alpha, beta, U, ldu,
1829 V, ldv, Q, ldq,
1830 work, iwork, info,
1831 1, 1, 1)
1832 end
1833 chklapackerror(info[])
1834 if m - k[1] - l[1] >= 0
1835 R = triu(A[1:k[1] + l[1],n - k[1] - l[1] + 1:n])
1836 else
1837 R = triu([A[1:m, n - k[1] - l[1] + 1:n]; B[m - k[1] + 1:l[1], n - k[1] - l[1] + 1:n]])
1838 end
1839 U, V, Q, alpha, beta, k[1], l[1], R
1840 end
1841 end
1842 end
1843
1844 """
1845 geev!(jobvl, jobvr, A) -> (W, VL, VR)
1846
1847 Finds the eigensystem of `A`. If `jobvl = N`, the left eigenvectors of
1848 `A` aren't computed. If `jobvr = N`, the right eigenvectors of `A`
1849 aren't computed. If `jobvl = V` or `jobvr = V`, the corresponding
1850 eigenvectors are computed. Returns the eigenvalues in `W`, the right
1851 eigenvectors in `VR`, and the left eigenvectors in `VL`.
1852 """
1853 geev!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix)
1854
1855 """
1856 gesdd!(job, A) -> (U, S, VT)
1857
1858 Finds the singular value decomposition of `A`, `A = U * S * V'`,
1859 using a divide and conquer approach. If `job = A`, all the columns of `U` and
1860 the rows of `V'` are computed. If `job = N`, no columns of `U` or rows of `V'`
1861 are computed. If `job = O`, `A` is overwritten with the columns of (thin) `U`
1862 and the rows of (thin) `V'`. If `job = S`, the columns of (thin) `U` and the
1863 rows of (thin) `V'` are computed and returned separately.
1864 """
1865 gesdd!(job::AbstractChar, A::AbstractMatrix)
1866
1867 """
1868 gesvd!(jobu, jobvt, A) -> (U, S, VT)
1869
1870 Finds the singular value decomposition of `A`, `A = U * S * V'`.
1871 If `jobu = A`, all the columns of `U` are computed. If `jobvt = A` all the rows
1872 of `V'` are computed. If `jobu = N`, no columns of `U` are computed. If
1873 `jobvt = N` no rows of `V'` are computed. If `jobu = O`, `A` is overwritten with
1874 the columns of (thin) `U`. If `jobvt = O`, `A` is overwritten with the rows
1875 of (thin) `V'`. If `jobu = S`, the columns of (thin) `U` are computed
1876 and returned separately. If `jobvt = S` the rows of (thin) `V'` are
1877 computed and returned separately. `jobu` and `jobvt` can't both be `O`.
1878
1879 Returns `U`, `S`, and `Vt`, where `S` are the singular values of `A`.
1880 """
1881 gesvd!(jobu::AbstractChar, jobvt::AbstractChar, A::AbstractMatrix)
1882
1883 """
1884 ggsvd!(jobu, jobv, jobq, A, B) -> (U, V, Q, alpha, beta, k, l, R)
1885
1886 Finds the generalized singular value decomposition of `A` and `B`, `U'*A*Q = D1*R`
1887 and `V'*B*Q = D2*R`. `D1` has `alpha` on its diagonal and `D2` has `beta` on its
1888 diagonal. If `jobu = U`, the orthogonal/unitary matrix `U` is computed. If
1889 `jobv = V` the orthogonal/unitary matrix `V` is computed. If `jobq = Q`,
1890 the orthogonal/unitary matrix `Q` is computed. If `jobu`, `jobv` or `jobq` is
1891 `N`, that matrix is not computed. This function is only available in LAPACK
1892 versions prior to 3.6.0.
1893 """
1894 ggsvd!(jobu::AbstractChar, jobv::AbstractChar, jobq::AbstractChar, A::AbstractMatrix, B::AbstractMatrix)
1895
1896
1897 for (f, elty) in ((:dggsvd3_, :Float64),
1898 (:sggsvd3_, :Float32))
1899 @eval begin
1900 function ggsvd3!(jobu::AbstractChar, jobv::AbstractChar, jobq::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
1901 require_one_based_indexing(A, B)
1902 chkstride1(A, B)
1903 m, n = size(A)
1904 if size(B, 2) != n
1905 throw(DimensionMismatch("B has second dimension $(size(B,2)) but needs $n"))
1906 end
1907 p = size(B, 1)
1908 k = Ref{BlasInt}()
1909 l = Ref{BlasInt}()
1910 lda = max(1, stride(A, 2))
1911 ldb = max(1, stride(B, 2))
1912 alpha = similar(A, $elty, n)
1913 beta = similar(A, $elty, n)
1914 ldu = max(1, m)
1915 U = jobu == 'U' ? similar(A, $elty, ldu, m) : similar(A, $elty, 0)
1916 ldv = max(1, p)
1917 V = jobv == 'V' ? similar(A, $elty, ldv, p) : similar(A, $elty, 0)
1918 ldq = max(1, n)
1919 Q = jobq == 'Q' ? similar(A, $elty, ldq, n) : similar(A, $elty, 0)
1920 work = Vector{$elty}(undef, 1)
1921 lwork = BlasInt(-1)
1922 iwork = Vector{BlasInt}(undef, n)
1923 info = Ref{BlasInt}()
1924 for i = 1:2 # first call returns lwork as work[1]
1925 ccall((@blasfunc($f), libblastrampoline), Cvoid,
1926 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
1927 Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
1928 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1929 Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
1930 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1931 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
1932 Clong, Clong, Clong),
1933 jobu, jobv, jobq, m,
1934 n, p, k, l,
1935 A, lda, B, ldb,
1936 alpha, beta, U, ldu,
1937 V, ldv, Q, ldq,
1938 work, lwork, iwork, info,
1939 1, 1, 1)
1940 chklapackerror(info[])
1941 if i == 1
1942 lwork = BlasInt(work[1])
1943 resize!(work, lwork)
1944 end
1945 end
1946 if m - k[] - l[] >= 0
1947 R = triu(A[1:k[] + l[],n - k[] - l[] + 1:n])
1948 else
1949 R = triu([A[1:m, n - k[] - l[] + 1:n]; B[m - k[] + 1:l[], n - k[] - l[] + 1:n]])
1950 end
1951 return U, V, Q, alpha, beta, k[], l[], R
1952 end
1953 end
1954 end
1955
1956 for (f, elty, relty) in ((:zggsvd3_, :ComplexF64, :Float64),
1957 (:cggsvd3_, :ComplexF32, :Float32))
1958 @eval begin
1959 function ggsvd3!(jobu::AbstractChar, jobv::AbstractChar, jobq::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
1960 require_one_based_indexing(A, B)
1961 chkstride1(A, B)
1962 m, n = size(A)
1963 if size(B, 2) != n
1964 throw(DimensionMismatch("B has second dimension $(size(B,2)) but needs $n"))
1965 end
1966 p = size(B, 1)
1967 k = Vector{BlasInt}(undef, 1)
1968 l = Vector{BlasInt}(undef, 1)
1969 lda = max(1,stride(A, 2))
1970 ldb = max(1,stride(B, 2))
1971 alpha = similar(A, $relty, n)
1972 beta = similar(A, $relty, n)
1973 ldu = max(1, m)
1974 U = jobu == 'U' ? similar(A, $elty, ldu, m) : similar(A, $elty, 0)
1975 ldv = max(1, p)
1976 V = jobv == 'V' ? similar(A, $elty, ldv, p) : similar(A, $elty, 0)
1977 ldq = max(1, n)
1978 Q = jobq == 'Q' ? similar(A, $elty, ldq, n) : similar(A, $elty, 0)
1979 work = Vector{$elty}(undef, 1)
1980 lwork = BlasInt(-1)
1981 rwork = Vector{$relty}(undef, 2n)
1982 iwork = Vector{BlasInt}(undef, n)
1983 info = Ref{BlasInt}()
1984 for i = 1:2 # first call returns lwork as work[1]
1985 ccall((@blasfunc($f), libblastrampoline), Cvoid,
1986 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
1987 Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt},
1988 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1989 Ptr{$relty}, Ptr{$relty}, Ptr{$elty}, Ref{BlasInt},
1990 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
1991 Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ptr{BlasInt},
1992 Ptr{BlasInt}, Clong, Clong, Clong),
1993 jobu, jobv, jobq, m,
1994 n, p, k, l,
1995 A, lda, B, ldb,
1996 alpha, beta, U, ldu,
1997 V, ldv, Q, ldq,
1998 work, lwork, rwork, iwork,
1999 info, 1, 1, 1)
2000 chklapackerror(info[])
2001 if i == 1
2002 lwork = BlasInt(work[1])
2003 resize!(work, lwork)
2004 end
2005 end
2006 if m - k[1] - l[1] >= 0
2007 R = triu(A[1:k[1] + l[1],n - k[1] - l[1] + 1:n])
2008 else
2009 R = triu([A[1:m, n - k[1] - l[1] + 1:n]; B[m - k[1] + 1:l[1], n - k[1] - l[1] + 1:n]])
2010 end
2011 return U, V, Q, alpha, beta, k[1], l[1], R
2012 end
2013 end
2014 end
2015
2016 """
2017 ggsvd3!(jobu, jobv, jobq, A, B) -> (U, V, Q, alpha, beta, k, l, R)
2018
2019 Finds the generalized singular value decomposition of `A` and `B`, `U'*A*Q = D1*R`
2020 and `V'*B*Q = D2*R`. `D1` has `alpha` on its diagonal and `D2` has `beta` on its
2021 diagonal. If `jobu = U`, the orthogonal/unitary matrix `U` is computed. If
2022 `jobv = V` the orthogonal/unitary matrix `V` is computed. If `jobq = Q`,
2023 the orthogonal/unitary matrix `Q` is computed. If `jobu`, `jobv`, or `jobq` is
2024 `N`, that matrix is not computed. This function requires LAPACK 3.6.0.
2025 """
2026 ggsvd3!
2027
2028 ## Expert driver and generalized eigenvalue problem
2029 for (geevx, ggev, ggev3, elty) in
2030 ((:dgeevx_,:dggev_,:dggev3_,:Float64),
2031 (:sgeevx_,:sggev_,:sggev3_,:Float32))
2032 @eval begin
2033 # SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
2034 # VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM,
2035 # RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
2036 #
2037 # .. Scalar Arguments ..
2038 # CHARACTER BALANC, JOBVL, JOBVR, SENSE
2039 # INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
2040 # DOUBLE PRECISION ABNRM
2041 # ..
2042 # .. Array Arguments ..
2043 # INTEGER IWORK( * )
2044 # DOUBLE PRECISION A( LDA, * ), RCONDE( * ), RCONDV( * ),
2045 # $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
2046 # $ WI( * ), WORK( * ), WR( * )
2047 function geevx!(balanc::AbstractChar, jobvl::AbstractChar, jobvr::AbstractChar, sense::AbstractChar, A::AbstractMatrix{$elty})
2048 n = checksquare(A)
2049 chkfinite(A) # balancing routines don't support NaNs and Infs
2050 lda = max(1,stride(A,2))
2051 wr = similar(A, $elty, n)
2052 wi = similar(A, $elty, n)
2053 if balanc ∉ ['N', 'P', 'S', 'B']
2054 throw(ArgumentError("balanc must be 'N', 'P', 'S', or 'B', but $balanc was passed"))
2055 end
2056 ldvl = 0
2057 if jobvl == 'V'
2058 ldvl = n
2059 elseif jobvl == 'N'
2060 ldvl = 0
2061 else
2062 throw(ArgumentError("jobvl must be 'V' or 'N', but $jobvl was passed"))
2063 end
2064 VL = similar(A, $elty, ldvl, n)
2065 ldvr = 0
2066 if jobvr == 'V'
2067 ldvr = n
2068 elseif jobvr == 'N'
2069 ldvr = 0
2070 else
2071 throw(ArgumentError("jobvr must be 'V' or 'N', but $jobvr was passed"))
2072 end
2073 VR = similar(A, $elty, ldvr, n)
2074 ilo = Ref{BlasInt}()
2075 ihi = Ref{BlasInt}()
2076 scale = similar(A, $elty, n)
2077 abnrm = Ref{$elty}()
2078 rconde = similar(A, $elty, n)
2079 rcondv = similar(A, $elty, n)
2080 work = Vector{$elty}(undef, 1)
2081 lwork = BlasInt(-1)
2082 iworksize = 0
2083 if sense == 'N' || sense == 'E'
2084 iworksize = 0
2085 elseif sense == 'V' || sense == 'B'
2086 iworksize = 2*n - 2
2087 else
2088 throw(ArgumentError("sense must be 'N', 'E', 'V' or 'B', but $sense was passed"))
2089 end
2090 iwork = Vector{BlasInt}(undef, iworksize)
2091 info = Ref{BlasInt}()
2092 for i = 1:2 # first call returns lwork as work[1]
2093 ccall((@blasfunc($geevx), libblastrampoline), Cvoid,
2094 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{UInt8},
2095 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2096 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2097 Ref{BlasInt}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty},
2098 Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
2099 Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
2100 Clong, Clong, Clong, Clong),
2101 balanc, jobvl, jobvr, sense,
2102 n, A, lda, wr,
2103 wi, VL, max(1,ldvl), VR,
2104 max(1,ldvr), ilo, ihi, scale,
2105 abnrm, rconde, rcondv, work,
2106 lwork, iwork, info,
2107 1, 1, 1, 1)
2108 chklapackerror(info[])
2109 if i == 1
2110 lwork = BlasInt(work[1])
2111 resize!(work, lwork)
2112 end
2113 end
2114 A, wr, wi, VL, VR, ilo[], ihi[], scale, abnrm[], rconde, rcondv
2115 end
2116
2117 # SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
2118 # $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
2119 # * .. Scalar Arguments ..
2120 # CHARACTER JOBVL, JOBVR
2121 # INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
2122 # * ..
2123 # * .. Array Arguments ..
2124 # DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
2125 # $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
2126 # $ VR( LDVR, * ), WORK( * )
2127 function ggev!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
2128 require_one_based_indexing(A, B)
2129 chkstride1(A,B)
2130 n, m = checksquare(A,B)
2131 if n != m
2132 throw(DimensionMismatch("A has dimensions $(size(A)), and B has dimensions $(size(B)), but A and B must have the same size"))
2133 end
2134 lda = max(1, stride(A, 2))
2135 ldb = max(1, stride(B, 2))
2136 alphar = similar(A, $elty, n)
2137 alphai = similar(A, $elty, n)
2138 beta = similar(A, $elty, n)
2139 ldvl = 0
2140 if jobvl == 'V'
2141 ldvl = n
2142 elseif jobvl == 'N'
2143 ldvl = 1
2144 else
2145 throw(ArgumentError("jobvl must be 'V' or 'N', but $jobvl was passed"))
2146 end
2147 vl = similar(A, $elty, ldvl, n)
2148 ldvr = 0
2149 if jobvr == 'V'
2150 ldvr = n
2151 elseif jobvr == 'N'
2152 ldvr = 1
2153 else
2154 throw(ArgumentError("jobvr must be 'V' or 'N', but $jobvr was passed"))
2155 end
2156 vr = similar(A, $elty, ldvr, n)
2157 work = Vector{$elty}(undef, 1)
2158 lwork = BlasInt(-1)
2159 info = Ref{BlasInt}()
2160 for i = 1:2 # first call returns lwork as work[1]
2161 ccall((@blasfunc($ggev), libblastrampoline), Cvoid,
2162 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
2163 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2164 Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
2165 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
2166 Ref{BlasInt}, Clong, Clong),
2167 jobvl, jobvr, n, A,
2168 lda, B, ldb, alphar,
2169 alphai, beta, vl, ldvl,
2170 vr, ldvr, work, lwork,
2171 info, 1, 1)
2172 chklapackerror(info[])
2173 if i == 1
2174 lwork = BlasInt(work[1])
2175 resize!(work, lwork)
2176 end
2177 end
2178 alphar, alphai, beta, vl, vr
2179 end
2180
2181 # SUBROUTINE DGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
2182 # $ BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
2183 # * .. Scalar Arguments ..
2184 # CHARACTER JOBVL, JOBVR
2185 # INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
2186 # * ..
2187 # * .. Array Arguments ..
2188 # DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
2189 # $ B( LDB, * ), BETA( * ), VL( LDVL, * ),
2190 # $ VR( LDVR, * ), WORK( * )
2191 function ggev3!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
2192 require_one_based_indexing(A, B)
2193 chkstride1(A,B)
2194 n, m = checksquare(A,B)
2195 if n != m
2196 throw(DimensionMismatch("A has dimensions $(size(A)), and B has dimensions $(size(B)), but A and B must have the same size"))
2197 end
2198 lda = max(1, stride(A, 2))
2199 ldb = max(1, stride(B, 2))
2200 alphar = similar(A, $elty, n)
2201 alphai = similar(A, $elty, n)
2202 beta = similar(A, $elty, n)
2203 ldvl = 0
2204 if jobvl == 'V'
2205 ldvl = n
2206 elseif jobvl == 'N'
2207 ldvl = 1
2208 else
2209 throw(ArgumentError("jobvl must be 'V' or 'N', but $jobvl was passed"))
2210 end
2211 vl = similar(A, $elty, ldvl, n)
2212 ldvr = 0
2213 if jobvr == 'V'
2214 ldvr = n
2215 elseif jobvr == 'N'
2216 ldvr = 1
2217 else
2218 throw(ArgumentError("jobvr must be 'V' or 'N', but $jobvr was passed"))
2219 end
2220 vr = similar(A, $elty, ldvr, n)
2221 work = Vector{$elty}(undef, 1)
2222 lwork = BlasInt(-1)
2223 info = Ref{BlasInt}()
2224 for i = 1:2 # first call returns lwork as work[1]
2225 ccall((@blasfunc($ggev3), libblastrampoline), Cvoid,
2226 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
2227 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2228 Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
2229 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
2230 Ref{BlasInt}, Clong, Clong),
2231 jobvl, jobvr, n, A,
2232 lda, B, ldb, alphar,
2233 alphai, beta, vl, ldvl,
2234 vr, ldvr, work, lwork,
2235 info, 1, 1)
2236 chklapackerror(info[])
2237 if i == 1
2238 lwork = BlasInt(work[1])
2239 resize!(work, lwork)
2240 end
2241 end
2242 alphar, alphai, beta, vl, vr
2243 end
2244 end
2245 end
2246
2247 for (geevx, ggev, ggev3, elty, relty) in
2248 ((:zgeevx_,:zggev_,:zggev3_,:ComplexF64,:Float64),
2249 (:cgeevx_,:cggev_,:cggev3_,:ComplexF32,:Float32))
2250 @eval begin
2251 # SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL,
2252 # LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE,
2253 # RCONDV, WORK, LWORK, RWORK, INFO )
2254 #
2255 # .. Scalar Arguments ..
2256 # CHARACTER BALANC, JOBVL, JOBVR, SENSE
2257 # INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
2258 # DOUBLE PRECISION ABNRM
2259 # ..
2260 # .. Array Arguments ..
2261 # DOUBLE PRECISION RCONDE( * ), RCONDV( * ), RWORK( * ),
2262 # $ SCALE( * )
2263 # COMPLEX*16 A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ),
2264 # $ W( * ), WORK( * )
2265 function geevx!(balanc::AbstractChar, jobvl::AbstractChar, jobvr::AbstractChar, sense::AbstractChar, A::AbstractMatrix{$elty})
2266 n = checksquare(A)
2267 chkfinite(A) # balancing routines don't support NaNs and Infs
2268 lda = max(1,stride(A,2))
2269 w = similar(A, $elty, n)
2270 if balanc ∉ ['N', 'P', 'S', 'B']
2271 throw(ArgumentError("balanc must be 'N', 'P', 'S', or 'B', but $balanc was passed"))
2272 end
2273 ldvl = 0
2274 if jobvl == 'V'
2275 ldvl = n
2276 elseif jobvl == 'N'
2277 ldvl = 0
2278 else
2279 throw(ArgumentError("jobvl must be 'V' or 'N', but $jobvl was passed"))
2280 end
2281 VL = similar(A, $elty, ldvl, n)
2282 ldvr = 0
2283 if jobvr == 'V'
2284 ldvr = n
2285 elseif jobvr == 'N'
2286 ldvr = 0
2287 else
2288 throw(ArgumentError("jobvr must be 'V' or 'N', but $jobvr was passed"))
2289 end
2290 if sense ∉ ['N','E','V','B']
2291 throw(ArgumentError("sense must be 'N', 'E', 'V' or 'B', but $sense was passed"))
2292 end
2293 VR = similar(A, $elty, ldvr, n)
2294 ilo = Ref{BlasInt}()
2295 ihi = Ref{BlasInt}()
2296 scale = similar(A, $relty, n)
2297 abnrm = Ref{$relty}()
2298 rconde = similar(A, $relty, n)
2299 rcondv = similar(A, $relty, n)
2300 work = Vector{$elty}(undef, 1)
2301 lwork = BlasInt(-1)
2302 rwork = Vector{$relty}(undef, 2n)
2303 info = Ref{BlasInt}()
2304 for i = 1:2 # first call returns lwork as work[1]
2305 ccall((@blasfunc($geevx), libblastrampoline), Cvoid,
2306 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{UInt8},
2307 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2308 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
2309 Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$relty}, Ptr{$relty},
2310 Ptr{$relty}, Ptr{$relty}, Ptr{$elty}, Ref{BlasInt},
2311 Ptr{$relty}, Ref{BlasInt}, Clong, Clong, Clong, Clong),
2312 balanc, jobvl, jobvr, sense,
2313 n, A, lda, w,
2314 VL, max(1,ldvl), VR, max(1,ldvr),
2315 ilo, ihi, scale, abnrm,
2316 rconde, rcondv, work, lwork,
2317 rwork, info, 1, 1, 1, 1)
2318 chklapackerror(info[])
2319 if i == 1
2320 lwork = BlasInt(work[1])
2321 resize!(work, lwork)
2322 end
2323 end
2324 A, w, VL, VR, ilo[], ihi[], scale, abnrm[], rconde, rcondv
2325 end
2326
2327 # SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
2328 # $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
2329 # * .. Scalar Arguments ..
2330 # CHARACTER JOBVL, JOBVR
2331 # INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
2332 # * ..
2333 # * .. Array Arguments ..
2334 # DOUBLE PRECISION RWORK( * )
2335 # COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
2336 # $ BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
2337 # $ WORK( * )
2338 function ggev!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
2339 require_one_based_indexing(A, B)
2340 chkstride1(A, B)
2341 n, m = checksquare(A, B)
2342 if n != m
2343 throw(DimensionMismatch("A has dimensions $(size(A)), and B has dimensions $(size(B)), but A and B must have the same size"))
2344 end
2345 lda = max(1, stride(A, 2))
2346 ldb = max(1, stride(B, 2))
2347 alpha = similar(A, $elty, n)
2348 beta = similar(A, $elty, n)
2349 ldvl = 0
2350 if jobvl == 'V'
2351 ldvl = n
2352 elseif jobvl == 'N'
2353 ldvl = 1
2354 else
2355 throw(ArgumentError("jobvl must be 'V' or 'N', but $jobvl was passed"))
2356 end
2357 vl = similar(A, $elty, ldvl, n)
2358 ldvr = 0
2359 if jobvr == 'V'
2360 ldvr = n
2361 elseif jobvr == 'N'
2362 ldvr = 1
2363 else
2364 throw(ArgumentError("jobvr must be 'V' or 'N', but $jobvr was passed"))
2365 end
2366 vr = similar(A, $elty, ldvr, n)
2367 work = Vector{$elty}(undef, 1)
2368 lwork = BlasInt(-1)
2369 rwork = Vector{$relty}(undef, 8n)
2370 info = Ref{BlasInt}()
2371 for i = 1:2 # first call returns lwork as work[1]
2372 ccall((@blasfunc($ggev), libblastrampoline), Cvoid,
2373 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
2374 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2375 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2376 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$relty},
2377 Ref{BlasInt}, Clong, Clong),
2378 jobvl, jobvr, n, A,
2379 lda, B, ldb, alpha,
2380 beta, vl, ldvl, vr,
2381 ldvr, work, lwork, rwork,
2382 info, 1, 1)
2383 chklapackerror(info[])
2384 if i == 1
2385 lwork = BlasInt(work[1])
2386 resize!(work, lwork)
2387 end
2388 end
2389 alpha, beta, vl, vr
2390 end
2391
2392 # SUBROUTINE ZGGEV3( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
2393 # $ VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO )
2394 # * .. Scalar Arguments ..
2395 # CHARACTER JOBVL, JOBVR
2396 # INTEGER INFO, LDA, LDB, LDVL, LDVR, LWORK, N
2397 # * ..
2398 # * .. Array Arguments ..
2399 # DOUBLE PRECISION RWORK( * )
2400 # COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
2401 # $ BETA( * ), VL( LDVL, * ), VR( LDVR, * ),
2402 # $ WORK( * )
2403 function ggev3!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
2404 require_one_based_indexing(A, B)
2405 chkstride1(A, B)
2406 n, m = checksquare(A, B)
2407 if n != m
2408 throw(DimensionMismatch("A has dimensions $(size(A)), and B has dimensions $(size(B)), but A and B must have the same size"))
2409 end
2410 lda = max(1, stride(A, 2))
2411 ldb = max(1, stride(B, 2))
2412 alpha = similar(A, $elty, n)
2413 beta = similar(A, $elty, n)
2414 ldvl = 0
2415 if jobvl == 'V'
2416 ldvl = n
2417 elseif jobvl == 'N'
2418 ldvl = 1
2419 else
2420 throw(ArgumentError("jobvl must be 'V' or 'N', but $jobvl was passed"))
2421 end
2422 vl = similar(A, $elty, ldvl, n)
2423 ldvr = 0
2424 if jobvr == 'V'
2425 ldvr = n
2426 elseif jobvr == 'N'
2427 ldvr = 1
2428 else
2429 throw(ArgumentError("jobvr must be 'V' or 'N', but $jobvr was passed"))
2430 end
2431 vr = similar(A, $elty, ldvr, n)
2432 work = Vector{$elty}(undef, 1)
2433 lwork = BlasInt(-1)
2434 rwork = Vector{$relty}(undef, 8n)
2435 info = Ref{BlasInt}()
2436 for i = 1:2 # first call returns lwork as work[1]
2437 ccall((@blasfunc($ggev3), libblastrampoline), Cvoid,
2438 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
2439 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2440 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2441 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$relty},
2442 Ref{BlasInt}, Clong, Clong),
2443 jobvl, jobvr, n, A,
2444 lda, B, ldb, alpha,
2445 beta, vl, ldvl, vr,
2446 ldvr, work, lwork, rwork,
2447 info, 1, 1)
2448 chklapackerror(info[])
2449 if i == 1
2450 lwork = BlasInt(work[1])
2451 resize!(work, lwork)
2452 end
2453 end
2454 alpha, beta, vl, vr
2455 end
2456 end
2457 end
2458
2459 """
2460 geevx!(balanc, jobvl, jobvr, sense, A) -> (A, w, VL, VR, ilo, ihi, scale, abnrm, rconde, rcondv)
2461
2462 Finds the eigensystem of `A` with matrix balancing. If `jobvl = N`, the
2463 left eigenvectors of `A` aren't computed. If `jobvr = N`, the right
2464 eigenvectors of `A` aren't computed. If `jobvl = V` or `jobvr = V`, the
2465 corresponding eigenvectors are computed. If `balanc = N`, no balancing is
2466 performed. If `balanc = P`, `A` is permuted but not scaled. If
2467 `balanc = S`, `A` is scaled but not permuted. If `balanc = B`, `A` is
2468 permuted and scaled. If `sense = N`, no reciprocal condition numbers are
2469 computed. If `sense = E`, reciprocal condition numbers are computed for
2470 the eigenvalues only. If `sense = V`, reciprocal condition numbers are
2471 computed for the right eigenvectors only. If `sense = B`, reciprocal
2472 condition numbers are computed for the right eigenvectors and the
2473 eigenvectors. If `sense = E,B`, the right and left eigenvectors must be
2474 computed.
2475 """
2476 geevx!(balanc::AbstractChar, jobvl::AbstractChar, jobvr::AbstractChar, sense::AbstractChar, A::AbstractMatrix)
2477
2478 """
2479 ggev!(jobvl, jobvr, A, B) -> (alpha, beta, vl, vr)
2480
2481 Finds the generalized eigendecomposition of `A` and `B`. If `jobvl = N`,
2482 the left eigenvectors aren't computed. If `jobvr = N`, the right
2483 eigenvectors aren't computed. If `jobvl = V` or `jobvr = V`, the
2484 corresponding eigenvectors are computed.
2485 """
2486 ggev!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix, B::AbstractMatrix)
2487
2488 """
2489 ggev3!(jobvl, jobvr, A, B) -> (alpha, beta, vl, vr)
2490
2491 Finds the generalized eigendecomposition of `A` and `B` using a blocked
2492 algorithm. If `jobvl = N`, the left eigenvectors aren't computed. If
2493 `jobvr = N`, the right eigenvectors aren't computed. If `jobvl = V` or
2494 `jobvr = V`, the corresponding eigenvectors are computed. This function
2495 requires LAPACK 3.6.0.
2496 """
2497 ggev3!(jobvl::AbstractChar, jobvr::AbstractChar, A::AbstractMatrix, B::AbstractMatrix)
2498
2499 # One step incremental condition estimation of max/min singular values
2500 for (laic1, elty) in
2501 ((:dlaic1_,:Float64),
2502 (:slaic1_,:Float32))
2503 @eval begin
2504 # SUBROUTINE DLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
2505 #
2506 # .. Scalar Arguments ..
2507 # INTEGER J, JOB
2508 # DOUBLE PRECISION C, GAMMA, S, SEST, SESTPR
2509 # ..
2510 # .. Array Arguments ..
2511 # DOUBLE PRECISION W( J ), X( J )
2512 function laic1!(job::Integer, x::AbstractVector{$elty},
2513 sest::$elty, w::AbstractVector{$elty}, gamma::$elty)
2514 require_one_based_indexing(x, w)
2515 j = length(x)
2516 if j != length(w)
2517 throw(DimensionMismatch("vectors must have same length, but length of x is $j and length of w is $(length(w))"))
2518 end
2519 sestpr = Vector{$elty}(undef, 1)
2520 s = Vector{$elty}(undef, 1)
2521 c = Vector{$elty}(undef, 1)
2522 ccall((@blasfunc($laic1), libblastrampoline), Cvoid,
2523 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{$elty},
2524 Ptr{$elty}, Ref{$elty}, Ptr{$elty}, Ptr{$elty},
2525 Ptr{$elty}),
2526 job, j, x, sest,
2527 w, gamma, sestpr, s,
2528 c)
2529 sestpr[1], s[1], c[1]
2530 end
2531 end
2532 end
2533 for (laic1, elty, relty) in
2534 ((:zlaic1_,:ComplexF64,:Float64),
2535 (:claic1_,:ComplexF32,:Float32))
2536 @eval begin
2537 # SUBROUTINE ZLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
2538 #
2539 # .. Scalar Arguments ..
2540 # INTEGER J, JOB
2541 # DOUBLE PRECISION SEST, SESTPR
2542 # COMPLEX*16 C, GAMMA, S
2543 # ..
2544 # .. Array Arguments ..
2545 # COMPLEX*16 W( J ), X( J )
2546 function laic1!(job::Integer, x::AbstractVector{$elty},
2547 sest::$relty, w::AbstractVector{$elty}, gamma::$elty)
2548 require_one_based_indexing(x, w)
2549 j = length(x)
2550 if j != length(w)
2551 throw(DimensionMismatch("vectors must have same length, but length of x is $j and length of w is $(length(w))"))
2552 end
2553 sestpr = Vector{$relty}(undef, 1)
2554 s = Vector{$elty}(undef, 1)
2555 c = Vector{$elty}(undef, 1)
2556 ccall((@blasfunc($laic1), libblastrampoline), Cvoid,
2557 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{$relty},
2558 Ptr{$elty}, Ref{$elty}, Ptr{$relty}, Ptr{$elty},
2559 Ptr{$elty}),
2560 job, j, x, sest,
2561 w, gamma, sestpr, s,
2562 c)
2563 sestpr[1], s[1], c[1]
2564 end
2565 end
2566 end
2567
2568 # (GT) General tridiagonal, decomposition, solver and direct solver
2569 for (gtsv, gttrf, gttrs, elty) in
2570 ((:dgtsv_,:dgttrf_,:dgttrs_,:Float64),
2571 (:sgtsv_,:sgttrf_,:sgttrs_,:Float32),
2572 (:zgtsv_,:zgttrf_,:zgttrs_,:ComplexF64),
2573 (:cgtsv_,:cgttrf_,:cgttrs_,:ComplexF32))
2574 @eval begin
2575 # SUBROUTINE DGTSV( N, NRHS, DL, D, DU, B, LDB, INFO )
2576 # .. Scalar Arguments ..
2577 # INTEGER INFO, LDB, N, NRHS
2578 # .. Array Arguments ..
2579 # DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * )
2580 function gtsv!(dl::AbstractVector{$elty}, d::AbstractVector{$elty}, du::AbstractVector{$elty},
2581 B::AbstractVecOrMat{$elty})
2582 require_one_based_indexing(dl, d, du, B)
2583 chkstride1(B, dl, d, du)
2584 n = length(d)
2585 if !(n >= length(dl) >= n - 1)
2586 throw(DimensionMismatch("subdiagonal has length $(length(dl)), but should be $n or $(n - 1)"))
2587 end
2588 if !(n >= length(du) >= n - 1)
2589 throw(DimensionMismatch("superdiagonal has length $(length(du)), but should be $n or $(n - 1)"))
2590 end
2591 if n != size(B,1)
2592 throw(DimensionMismatch("B has leading dimension $(size(B,1)), but should have $n"))
2593 end
2594 if n == 0
2595 return B # Early exit if possible
2596 end
2597 info = Ref{BlasInt}()
2598 ccall((@blasfunc($gtsv), libblastrampoline), Cvoid,
2599 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
2600 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
2601 n, size(B,2), dl, d, du, B, max(1,stride(B,2)), info)
2602 chklapackerror(info[])
2603 B
2604 end
2605
2606 # SUBROUTINE DGTTRF( N, DL, D, DU, DU2, IPIV, INFO )
2607 # .. Scalar Arguments ..
2608 # INTEGER INFO, N
2609 # .. Array Arguments ..
2610 # INTEGER IPIV( * )
2611 # DOUBLE PRECISION D( * ), DL( * ), DU( * ), DU2( * )
2612 function gttrf!(dl::AbstractVector{$elty}, d::AbstractVector{$elty}, du::AbstractVector{$elty})
2613 require_one_based_indexing(dl, d, du)
2614 chkstride1(dl,d,du)
2615 n = length(d)
2616 if length(dl) != n - 1
2617 throw(DimensionMismatch("subdiagonal has length $(length(dl)), but should be $(n - 1)"))
2618 end
2619 if length(du) != n - 1
2620 throw(DimensionMismatch("superdiagonal has length $(length(du)), but should be $(n - 1)"))
2621 end
2622 du2 = similar(d, $elty, n-2)
2623 ipiv = similar(d, BlasInt, n)
2624 info = Ref{BlasInt}()
2625 ccall((@blasfunc($gttrf), libblastrampoline), Cvoid,
2626 (Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
2627 Ptr{BlasInt}, Ptr{BlasInt}),
2628 n, dl, d, du, du2, ipiv, info)
2629 chklapackerror(info[])
2630 dl, d, du, du2, ipiv
2631 end
2632
2633 # SUBROUTINE DGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, INFO )
2634 # .. Scalar Arguments ..
2635 # CHARACTER TRANS
2636 # INTEGER INFO, LDB, N, NRHS
2637 # .. Array Arguments ..
2638 # INTEGER IPIV( * )
2639 # DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
2640 function gttrs!(trans::AbstractChar, dl::AbstractVector{$elty}, d::AbstractVector{$elty},
2641 du::AbstractVector{$elty}, du2::AbstractVector{$elty}, ipiv::AbstractVector{BlasInt},
2642 B::AbstractVecOrMat{$elty})
2643 require_one_based_indexing(dl, d, du, du2, ipiv, B)
2644 chktrans(trans)
2645 chkstride1(B, ipiv, dl, d, du, du2)
2646 n = length(d)
2647 if length(dl) != n - 1
2648 throw(DimensionMismatch("subdiagonal has length $(length(dl)), but should be $(n - 1)"))
2649 end
2650 if length(du) != n - 1
2651 throw(DimensionMismatch("superdiagonal has length $(length(du)), but should be $(n - 1)"))
2652 end
2653 if n != size(B,1)
2654 throw(DimensionMismatch("B has leading dimension $(size(B,1)), but should have $n"))
2655 end
2656 info = Ref{BlasInt}()
2657 ccall((@blasfunc($gttrs), libblastrampoline), Cvoid,
2658 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
2659 Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
2660 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
2661 trans, n, size(B,2), dl, d, du, du2, ipiv, B, max(1,stride(B,2)), info, 1)
2662 chklapackerror(info[])
2663 B
2664 end
2665 end
2666 end
2667
2668 """
2669 gtsv!(dl, d, du, B)
2670
2671 Solves the equation `A * X = B` where `A` is a tridiagonal matrix with
2672 `dl` on the subdiagonal, `d` on the diagonal, and `du` on the
2673 superdiagonal.
2674
2675 Overwrites `B` with the solution `X` and returns it.
2676 """
2677 gtsv!(dl::AbstractVector, d::AbstractVector, du::AbstractVector, B::AbstractVecOrMat)
2678
2679 """
2680 gttrf!(dl, d, du) -> (dl, d, du, du2, ipiv)
2681
2682 Finds the `LU` factorization of a tridiagonal matrix with `dl` on the
2683 subdiagonal, `d` on the diagonal, and `du` on the superdiagonal.
2684
2685 Modifies `dl`, `d`, and `du` in-place and returns them and the second
2686 superdiagonal `du2` and the pivoting vector `ipiv`.
2687 """
2688 gttrf!(dl::AbstractVector, d::AbstractVector, du::AbstractVector)
2689
2690 """
2691 gttrs!(trans, dl, d, du, du2, ipiv, B)
2692
2693 Solves the equation `A * X = B` (`trans = N`), `transpose(A) * X = B` (`trans = T`),
2694 or `adjoint(A) * X = B` (`trans = C`) using the `LU` factorization computed by
2695 `gttrf!`. `B` is overwritten with the solution `X`.
2696 """
2697 gttrs!(trans::AbstractChar, dl::AbstractVector, d::AbstractVector, du::AbstractVector, du2::AbstractVector,
2698 ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat)
2699
2700 ## (OR) orthogonal (or UN, unitary) matrices, extractors and multiplication
2701 for (orglq, orgqr, orgql, orgrq, ormlq, ormqr, ormql, ormrq, gemqrt, elty) in
2702 ((:dorglq_,:dorgqr_,:dorgql_,:dorgrq_,:dormlq_,:dormqr_,:dormql_,:dormrq_,:dgemqrt_,:Float64),
2703 (:sorglq_,:sorgqr_,:sorgql_,:sorgrq_,:sormlq_,:sormqr_,:sormql_,:sormrq_,:sgemqrt_,:Float32),
2704 (:zunglq_,:zungqr_,:zungql_,:zungrq_,:zunmlq_,:zunmqr_,:zunmql_,:zunmrq_,:zgemqrt_,:ComplexF64),
2705 (:cunglq_,:cungqr_,:cungql_,:cungrq_,:cunmlq_,:cunmqr_,:cunmql_,:cunmrq_,:cgemqrt_,:ComplexF32))
2706 @eval begin
2707 # SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
2708 # * .. Scalar Arguments ..
2709 # INTEGER INFO, K, LDA, LWORK, M, N
2710 # * .. Array Arguments ..
2711 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
2712 function orglq!(A::AbstractMatrix{$elty}, tau::AbstractVector{$elty}, k::Integer = length(tau))
2713 require_one_based_indexing(A, tau)
2714 chkstride1(A,tau)
2715 n = size(A, 2)
2716 m = min(n, size(A, 1))
2717 if k > m
2718 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= m = $m"))
2719 end
2720 work = Vector{$elty}(undef, 1)
2721 lwork = BlasInt(-1)
2722 info = Ref{BlasInt}()
2723 for i = 1:2 # first call returns lwork as work[1]
2724 ccall((@blasfunc($orglq), libblastrampoline), Cvoid,
2725 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
2726 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
2727 m, n, k, A, max(1,stride(A,2)), tau, work, lwork, info)
2728 chklapackerror(info[])
2729 if i == 1
2730 lwork = BlasInt(real(work[1]))
2731 resize!(work, lwork)
2732 end
2733 end
2734 if m < size(A,1)
2735 A[1:m,:]
2736 else
2737 A
2738 end
2739 end
2740
2741 # SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
2742 # * .. Scalar Arguments ..
2743 # INTEGER INFO, K, LDA, LWORK, M, N
2744 # * .. Array Arguments ..
2745 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
2746 function orgqr!(A::AbstractMatrix{$elty}, tau::AbstractVector{$elty}, k::Integer = length(tau))
2747 require_one_based_indexing(A, tau)
2748 chkstride1(A,tau)
2749 m = size(A, 1)
2750 n = min(m, size(A, 2))
2751 if k > n
2752 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= n = $n"))
2753 end
2754 work = Vector{$elty}(undef, 1)
2755 lwork = BlasInt(-1)
2756 info = Ref{BlasInt}()
2757 for i = 1:2 # first call returns lwork as work[1]
2758 ccall((@blasfunc($orgqr), libblastrampoline), Cvoid,
2759 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
2760 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
2761 m, n, k, A,
2762 max(1,stride(A,2)), tau, work, lwork,
2763 info)
2764 chklapackerror(info[])
2765 if i == 1
2766 lwork = BlasInt(real(work[1]))
2767 resize!(work, lwork)
2768 end
2769 end
2770 if n < size(A,2)
2771 A[:,1:n]
2772 else
2773 A
2774 end
2775 end
2776
2777 # SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
2778 # * .. Scalar Arguments ..
2779 # INTEGER INFO, K, LDA, LWORK, M, N
2780 # * .. Array Arguments ..
2781 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
2782 function orgql!(A::AbstractMatrix{$elty}, tau::AbstractVector{$elty}, k::Integer = length(tau))
2783 require_one_based_indexing(A, tau)
2784 chkstride1(A,tau)
2785 m = size(A, 1)
2786 n = min(m, size(A, 2))
2787 if k > n
2788 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= n = $n"))
2789 end
2790 work = Vector{$elty}(undef, 1)
2791 lwork = BlasInt(-1)
2792 info = Ref{BlasInt}()
2793 for i = 1:2 # first call returns lwork as work[1]
2794 ccall((@blasfunc($orgql), libblastrampoline), Cvoid,
2795 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
2796 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
2797 m, n, k, A,
2798 max(1,stride(A,2)), tau, work, lwork,
2799 info)
2800 chklapackerror(info[])
2801 if i == 1
2802 lwork = BlasInt(real(work[1]))
2803 resize!(work, lwork)
2804 end
2805 end
2806 if n < size(A,2)
2807 A[:,1:n]
2808 else
2809 A
2810 end
2811 end
2812
2813 # SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
2814 # * .. Scalar Arguments ..
2815 # INTEGER INFO, K, LDA, LWORK, M, N
2816 # * .. Array Arguments ..
2817 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
2818 function orgrq!(A::AbstractMatrix{$elty}, tau::AbstractVector{$elty}, k::Integer = length(tau))
2819 require_one_based_indexing(A, tau)
2820 chkstride1(A,tau)
2821 m, n = size(A)
2822 if n < m
2823 throw(DimensionMismatch("input matrix A has dimensions ($m,$n), but cannot have fewer columns than rows"))
2824 end
2825 if k > n
2826 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= n = $n"))
2827 end
2828 work = Vector{$elty}(undef, 1)
2829 lwork = BlasInt(-1)
2830 info = Ref{BlasInt}()
2831 for i = 1:2 # first call returns lwork as work[1]
2832 ccall((@blasfunc($orgrq), libblastrampoline), Cvoid,
2833 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
2834 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
2835 m, n, k, A,
2836 max(1,stride(A,2)), tau, work, lwork,
2837 info)
2838 chklapackerror(info[])
2839 if i == 1
2840 lwork = BlasInt(real(work[1]))
2841 resize!(work, lwork)
2842 end
2843 end
2844 A
2845 end
2846
2847 # SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
2848 # WORK, LWORK, INFO )
2849 # .. Scalar Arguments ..
2850 # CHARACTER SIDE, TRANS
2851 # INTEGER INFO, K, LDA, LDC, LWORK, M, N
2852 # .. Array Arguments ..
2853 # DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
2854 function ormlq!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
2855 tau::AbstractVector{$elty}, C::AbstractVecOrMat{$elty})
2856 require_one_based_indexing(A, tau, C)
2857 chktrans(trans)
2858 chkside(side)
2859 chkstride1(A, C, tau)
2860 m,n = ndims(C) == 2 ? size(C) : (size(C, 1), 1)
2861 nA = size(A, 2)
2862 k = length(tau)
2863 if side == 'L' && m != nA
2864 throw(DimensionMismatch("for a left-sided multiplication, the first dimension of C, $m, must equal the second dimension of A, $nA"))
2865 end
2866 if side == 'R' && n != nA
2867 throw(DimensionMismatch("for a right-sided multiplication, the second dimension of C, $n, must equal the second dimension of A, $nA"))
2868 end
2869 if side == 'L' && k > m
2870 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= m = $m"))
2871 end
2872 if side == 'R' && k > n
2873 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= n = $n"))
2874 end
2875 work = Vector{$elty}(undef, 1)
2876 lwork = BlasInt(-1)
2877 info = Ref{BlasInt}()
2878 for i = 1:2 # first call returns lwork as work[1]
2879 ccall((@blasfunc($ormlq), libblastrampoline), Cvoid,
2880 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
2881 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
2882 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
2883 side, trans, m, n, k, A, max(1,stride(A,2)), tau,
2884 C, max(1,stride(C,2)), work, lwork, info, 1, 1)
2885 chklapackerror(info[])
2886 if i == 1
2887 lwork = BlasInt(real(work[1]))
2888 resize!(work, lwork)
2889 end
2890 end
2891 C
2892 end
2893
2894 # SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
2895 # WORK, INFO )
2896 # .. Scalar Arguments ..
2897 # CHARACTER SIDE, TRANS
2898 # INTEGER INFO, K, LDA, LDC, M, N
2899 # .. Array Arguments ..
2900 # DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
2901 function ormqr!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
2902 tau::AbstractVector{$elty}, C::AbstractVecOrMat{$elty})
2903 require_one_based_indexing(A, tau, C)
2904 chktrans(trans)
2905 chkside(side)
2906 chkstride1(A, C, tau)
2907 m,n = ndims(C) == 2 ? size(C) : (size(C, 1), 1)
2908 mA = size(A, 1)
2909 k = length(tau)
2910 if side == 'L' && m != mA
2911 throw(DimensionMismatch("for a left-sided multiplication, the first dimension of C, $m, must equal the second dimension of A, $mA"))
2912 end
2913 if side == 'R' && n != mA
2914 throw(DimensionMismatch("for a right-sided multiplication, the second dimension of C, $m, must equal the second dimension of A, $mA"))
2915 end
2916 if side == 'L' && k > m
2917 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= m = $m"))
2918 end
2919 if side == 'R' && k > n
2920 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= n = $n"))
2921 end
2922 work = Vector{$elty}(undef, 1)
2923 lwork = BlasInt(-1)
2924 info = Ref{BlasInt}()
2925 for i = 1:2 # first call returns lwork as work[1]
2926 ccall((@blasfunc($ormqr), libblastrampoline), Cvoid,
2927 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
2928 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2929 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
2930 Ptr{BlasInt}, Clong, Clong),
2931 side, trans, m, n,
2932 k, A, max(1,stride(A,2)), tau,
2933 C, max(1, stride(C,2)), work, lwork,
2934 info, 1, 1)
2935 chklapackerror(info[])
2936 if i == 1
2937 lwork = BlasInt(real(work[1]))
2938 resize!(work, lwork)
2939 end
2940 end
2941 C
2942 end
2943
2944 # SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
2945 # WORK, INFO )
2946 # .. Scalar Arguments ..
2947 # CHARACTER SIDE, TRANS
2948 # INTEGER INFO, K, LDA, LDC, M, N
2949 # .. Array Arguments ..
2950 # DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
2951 function ormql!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
2952 tau::AbstractVector{$elty}, C::AbstractVecOrMat{$elty})
2953 require_one_based_indexing(A, tau, C)
2954 chktrans(trans)
2955 chkside(side)
2956 chkstride1(A, C, tau)
2957 m,n = ndims(C) == 2 ? size(C) : (size(C, 1), 1)
2958 mA = size(A, 1)
2959 k = length(tau)
2960 if side == 'L' && m != mA
2961 throw(DimensionMismatch("for a left-sided multiplication, the first dimension of C, $m, must equal the second dimension of A, $mA"))
2962 end
2963 if side == 'R' && n != mA
2964 throw(DimensionMismatch("for a right-sided multiplication, the second dimension of C, $m, must equal the second dimension of A, $mA"))
2965 end
2966 if side == 'L' && k > m
2967 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= m = $m"))
2968 end
2969 if side == 'R' && k > n
2970 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= n = $n"))
2971 end
2972 work = Vector{$elty}(undef, 1)
2973 lwork = BlasInt(-1)
2974 info = Ref{BlasInt}()
2975 for i = 1:2 # first call returns lwork as work[1]
2976 ccall((@blasfunc($ormql), libblastrampoline), Cvoid,
2977 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
2978 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
2979 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
2980 Ptr{BlasInt}, Clong, Clong),
2981 side, trans, m, n,
2982 k, A, max(1,stride(A,2)), tau,
2983 C, max(1, stride(C,2)), work, lwork,
2984 info, 1, 1)
2985 chklapackerror(info[])
2986 if i == 1
2987 lwork = BlasInt(real(work[1]))
2988 resize!(work, lwork)
2989 end
2990 end
2991 C
2992 end
2993
2994 # SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
2995 # WORK, LWORK, INFO )
2996 # .. Scalar Arguments ..
2997 # CHARACTER SIDE, TRANS
2998 # INTEGER INFO, K, LDA, LDC, LWORK, M, N
2999 # .. Array Arguments ..
3000 # DOUBLE PRECISION A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
3001 function ormrq!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
3002 tau::AbstractVector{$elty}, C::AbstractVecOrMat{$elty})
3003 require_one_based_indexing(A, tau, C)
3004 chktrans(trans)
3005 chkside(side)
3006 chkstride1(A, C, tau)
3007 m,n = ndims(C) == 2 ? size(C) : (size(C, 1), 1)
3008 nA = size(A, 2)
3009 k = length(tau)
3010 if side == 'L' && m != nA
3011 throw(DimensionMismatch("for a left-sided multiplication, the first dimension of C, $m, must equal the second dimension of A, $nA"))
3012 end
3013 if side == 'R' && n != nA
3014 throw(DimensionMismatch("for a right-sided multiplication, the second dimension of C, $m, must equal the second dimension of A, $nA"))
3015 end
3016 if side == 'L' && k > m
3017 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= m = $m"))
3018 end
3019 if side == 'R' && k > n
3020 throw(DimensionMismatch("invalid number of reflectors: k = $k should be <= n = $n"))
3021 end
3022 work = Vector{$elty}(undef, 1)
3023 lwork = BlasInt(-1)
3024 info = Ref{BlasInt}()
3025 for i = 1:2 # first call returns lwork as work[1]
3026 ccall((@blasfunc($ormrq), libblastrampoline), Cvoid,
3027 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
3028 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
3029 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
3030 side, trans, m, n, k, A, max(1,stride(A,2)), tau,
3031 C, max(1,stride(C,2)), work, lwork, info, 1, 1)
3032 chklapackerror(info[])
3033 if i == 1
3034 lwork = BlasInt(real(work[1]))
3035 resize!(work, lwork)
3036 end
3037 end
3038 C
3039 end
3040
3041 function gemqrt!(side::AbstractChar, trans::AbstractChar, V::AbstractMatrix{$elty}, T::AbstractMatrix{$elty}, C::AbstractVecOrMat{$elty})
3042 require_one_based_indexing(V, T, C)
3043 chktrans(trans)
3044 chkside(side)
3045 chkstride1(V, T, C)
3046 m,n = ndims(C) == 2 ? size(C) : (size(C, 1), 1)
3047 nb, k = size(T)
3048 if k == 0
3049 return C
3050 end
3051 if side == 'L'
3052 if !(0 <= k <= m)
3053 throw(DimensionMismatch("wrong value for k = $k: must be between 0 and $m"))
3054 end
3055 if m != size(V,1)
3056 throw(DimensionMismatch("first dimensions of C, $m, and V, $(size(V,1)) must match"))
3057 end
3058 ldv = stride(V,2)
3059 if ldv < max(1, m)
3060 throw(DimensionMismatch("Q and C don't fit! The stride of V, $ldv, is too small"))
3061 end
3062 wss = n*k
3063 elseif side == 'R'
3064 if !(0 <= k <= n)
3065 throw(DimensionMismatch("wrong value for k = $k: must be between 0 and $n"))
3066 end
3067 if n != size(V,1)
3068 throw(DimensionMismatch("second dimension of C, $n, and first dimension of V, $(size(V,1)) must match"))
3069 end
3070 ldv = stride(V,2)
3071 if ldv < max(1, n)
3072 throw(DimensionMismatch("Q and C don't fit! The stride of V, $ldv, is too small"))
3073 end
3074 wss = m*k
3075 end
3076 if !(1 <= nb <= k)
3077 throw(DimensionMismatch("wrong value for nb = $nb, which must be between 1 and $k"))
3078 end
3079 ldc = stride(C, 2)
3080 work = Vector{$elty}(undef, wss)
3081 info = Ref{BlasInt}()
3082 ccall((@blasfunc($gemqrt), libblastrampoline), Cvoid,
3083 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
3084 Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3085 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3086 Ptr{$elty}, Ptr{BlasInt}, Clong, Clong),
3087 side, trans, m, n,
3088 k, nb, V, ldv,
3089 T, max(1,stride(T,2)), C, max(1,ldc),
3090 work, info, 1, 1)
3091 chklapackerror(info[])
3092 return C
3093 end
3094 end
3095 end
3096
3097 """
3098 orglq!(A, tau, k = length(tau))
3099
3100 Explicitly finds the matrix `Q` of a `LQ` factorization after calling
3101 `gelqf!` on `A`. Uses the output of `gelqf!`. `A` is overwritten by `Q`.
3102 """
3103 orglq!(A::AbstractMatrix, tau::AbstractVector, k::Integer = length(tau))
3104
3105 """
3106 orgqr!(A, tau, k = length(tau))
3107
3108 Explicitly finds the matrix `Q` of a `QR` factorization after calling
3109 `geqrf!` on `A`. Uses the output of `geqrf!`. `A` is overwritten by `Q`.
3110 """
3111 orgqr!(A::AbstractMatrix, tau::AbstractVector, k::Integer = length(tau))
3112
3113 """
3114 orgql!(A, tau, k = length(tau))
3115
3116 Explicitly finds the matrix `Q` of a `QL` factorization after calling
3117 `geqlf!` on `A`. Uses the output of `geqlf!`. `A` is overwritten by `Q`.
3118 """
3119 orgql!(A::AbstractMatrix, tau::AbstractVector, k::Integer = length(tau))
3120
3121 """
3122 orgrq!(A, tau, k = length(tau))
3123
3124 Explicitly finds the matrix `Q` of a `RQ` factorization after calling
3125 `gerqf!` on `A`. Uses the output of `gerqf!`. `A` is overwritten by `Q`.
3126 """
3127 orgrq!(A::AbstractMatrix, tau::AbstractVector, k::Integer = length(tau))
3128
3129 """
3130 ormlq!(side, trans, A, tau, C)
3131
3132 Computes `Q * C` (`trans = N`), `transpose(Q) * C` (`trans = T`), `adjoint(Q) * C`
3133 (`trans = C`) for `side = L` or the equivalent right-sided multiplication
3134 for `side = R` using `Q` from a `LQ` factorization of `A` computed using
3135 `gelqf!`. `C` is overwritten.
3136 """
3137 ormlq!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix, tau::AbstractVector, C::AbstractVecOrMat)
3138
3139 """
3140 ormqr!(side, trans, A, tau, C)
3141
3142 Computes `Q * C` (`trans = N`), `transpose(Q) * C` (`trans = T`), `adjoint(Q) * C`
3143 (`trans = C`) for `side = L` or the equivalent right-sided multiplication
3144 for `side = R` using `Q` from a `QR` factorization of `A` computed using
3145 `geqrf!`. `C` is overwritten.
3146 """
3147 ormqr!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix, tau::AbstractVector, C::AbstractVecOrMat)
3148
3149 """
3150 ormql!(side, trans, A, tau, C)
3151
3152 Computes `Q * C` (`trans = N`), `transpose(Q) * C` (`trans = T`), `adjoint(Q) * C`
3153 (`trans = C`) for `side = L` or the equivalent right-sided multiplication
3154 for `side = R` using `Q` from a `QL` factorization of `A` computed using
3155 `geqlf!`. `C` is overwritten.
3156 """
3157 ormql!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix, tau::AbstractVector, C::AbstractVecOrMat)
3158
3159 """
3160 ormrq!(side, trans, A, tau, C)
3161
3162 Computes `Q * C` (`trans = N`), `transpose(Q) * C` (`trans = T`), `adjoint(Q) * C`
3163 (`trans = C`) for `side = L` or the equivalent right-sided multiplication
3164 for `side = R` using `Q` from a `RQ` factorization of `A` computed using
3165 `gerqf!`. `C` is overwritten.
3166 """
3167 ormrq!(side::AbstractChar, trans::AbstractChar, A::AbstractMatrix, tau::AbstractVector, C::AbstractVecOrMat)
3168
3169 """
3170 gemqrt!(side, trans, V, T, C)
3171
3172 Computes `Q * C` (`trans = N`), `transpose(Q) * C` (`trans = T`), `adjoint(Q) * C`
3173 (`trans = C`) for `side = L` or the equivalent right-sided multiplication
3174 for `side = R` using `Q` from a `QR` factorization of `A` computed using
3175 `geqrt!`. `C` is overwritten.
3176 """
3177 gemqrt!(side::AbstractChar, trans::AbstractChar, V::AbstractMatrix, T::AbstractMatrix, C::AbstractVecOrMat)
3178
3179 # (PO) positive-definite symmetric matrices,
3180 for (posv, potrf, potri, potrs, pstrf, elty, rtyp) in
3181 ((:dposv_,:dpotrf_,:dpotri_,:dpotrs_,:dpstrf_,:Float64,:Float64),
3182 (:sposv_,:spotrf_,:spotri_,:spotrs_,:spstrf_,:Float32,:Float32),
3183 (:zposv_,:zpotrf_,:zpotri_,:zpotrs_,:zpstrf_,:ComplexF64,:Float64),
3184 (:cposv_,:cpotrf_,:cpotri_,:cpotrs_,:cpstrf_,:ComplexF32,:Float32))
3185 @eval begin
3186 # SUBROUTINE DPOSV( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
3187 #* .. Scalar Arguments ..
3188 # CHARACTER UPLO
3189 # INTEGER INFO, LDA, LDB, N, NRHS
3190 # .. Array Arguments ..
3191 # DOUBLE PRECISION A( LDA, * ), B( LDB, * )
3192 function posv!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
3193 require_one_based_indexing(A, B)
3194 chkstride1(A, B)
3195 n = checksquare(A)
3196 chkuplo(uplo)
3197 if size(B,1) != n
3198 throw(DimensionMismatch("first dimension of B, $(size(B,1)), and size of A, ($n,$n), must match!"))
3199 end
3200 info = Ref{BlasInt}()
3201 ccall((@blasfunc($posv), libblastrampoline), Cvoid,
3202 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3203 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
3204 uplo, n, size(B,2), A, max(1,stride(A,2)), B, max(1,stride(B,2)), info, 1)
3205 chkargsok(info[])
3206 chkposdef(info[])
3207 A, B
3208 end
3209
3210 # SUBROUTINE DPOTRF( UPLO, N, A, LDA, INFO )
3211 # * .. Scalar Arguments ..
3212 # CHARACTER UPLO
3213 # INTEGER INFO, LDA, N
3214 # * .. Array Arguments ..
3215 # DOUBLE PRECISION A( LDA, * )
3216 function potrf!(uplo::AbstractChar, A::AbstractMatrix{$elty})
3217 require_one_based_indexing(A)
3218 chkstride1(A)
3219 checksquare(A)
3220 chkuplo(uplo)
3221 lda = max(1,stride(A,2))
3222 if lda == 0
3223 return A, 0
3224 end
3225 info = Ref{BlasInt}()
3226 ccall((@blasfunc($potrf), libblastrampoline), Cvoid,
3227 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
3228 uplo, size(A,1), A, lda, info, 1)
3229 chkargsok(info[])
3230 #info[] > 0 means the leading minor of order info[] is not positive definite
3231 #ordinarily, throw Exception here, but return error code here
3232 #this simplifies isposdef! and factorize
3233 return A, info[] # info stored in Cholesky
3234 end
3235
3236 # SUBROUTINE DPOTRI( UPLO, N, A, LDA, INFO )
3237 # .. Scalar Arguments ..
3238 # CHARACTER UPLO
3239 # INTEGER INFO, LDA, N
3240 # .. Array Arguments ..
3241 # DOUBLE PRECISION A( LDA, * )
3242 function potri!(uplo::AbstractChar, A::AbstractMatrix{$elty})
3243 require_one_based_indexing(A)
3244 chkstride1(A)
3245 chkuplo(uplo)
3246 info = Ref{BlasInt}()
3247 ccall((@blasfunc($potri), libblastrampoline), Cvoid,
3248 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
3249 uplo, size(A,1), A, max(1,stride(A,2)), info, 1)
3250 chkargsok(info[])
3251 chknonsingular(info[])
3252 A
3253 end
3254
3255 # SUBROUTINE DPOTRS( UPLO, N, NRHS, A, LDA, B, LDB, INFO )
3256 # .. Scalar Arguments ..
3257 # CHARACTER UPLO
3258 # INTEGER INFO, LDA, LDB, N, NRHS
3259 # .. Array Arguments ..
3260 # DOUBLE PRECISION A( LDA, * ), B( LDB, * )
3261 function potrs!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
3262 require_one_based_indexing(A, B)
3263 chkstride1(A, B)
3264 n = checksquare(A)
3265 chkuplo(uplo)
3266 nrhs = size(B,2)
3267 if size(B,1) != n
3268 throw(DimensionMismatch("first dimension of B, $(size(B,1)), and size of A, ($n,$n), must match!"))
3269 end
3270 lda = max(1,stride(A,2))
3271 if lda == 0 || nrhs == 0
3272 return B
3273 end
3274 ldb = max(1,stride(B,2))
3275 info = Ref{BlasInt}()
3276 ccall((@blasfunc($potrs), libblastrampoline), Cvoid,
3277 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
3278 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
3279 uplo, n, nrhs, A,
3280 lda, B, ldb, info, 1)
3281 chklapackerror(info[])
3282 return B
3283 end
3284
3285 # SUBROUTINE DPSTRF( UPLO, N, A, LDA, PIV, RANK, TOL, WORK, INFO )
3286 # .. Scalar Arguments ..
3287 # DOUBLE PRECISION TOL
3288 # INTEGER INFO, LDA, N, RANK
3289 # CHARACTER UPLO
3290 # .. Array Arguments ..
3291 # DOUBLE PRECISION A( LDA, * ), WORK( 2*N )
3292 # INTEGER PIV( N )
3293 function pstrf!(uplo::AbstractChar, A::AbstractMatrix{$elty}, tol::Real)
3294 chkstride1(A)
3295 n = checksquare(A)
3296 chkuplo(uplo)
3297 piv = similar(A, BlasInt, n)
3298 rank = Vector{BlasInt}(undef, 1)
3299 work = Vector{$rtyp}(undef, 2n)
3300 info = Ref{BlasInt}()
3301 ccall((@blasfunc($pstrf), libblastrampoline), Cvoid,
3302 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
3303 Ptr{BlasInt}, Ref{$rtyp}, Ptr{$rtyp}, Ptr{BlasInt}, Clong),
3304 uplo, n, A, max(1,stride(A,2)), piv, rank, tol, work, info, 1)
3305 chkargsok(info[])
3306 A, piv, rank[1], info[] #Stored in CholeskyPivoted
3307 end
3308 end
3309 end
3310
3311 """
3312 posv!(uplo, A, B) -> (A, B)
3313
3314 Finds the solution to `A * X = B` where `A` is a symmetric or Hermitian
3315 positive definite matrix. If `uplo = U` the upper Cholesky decomposition
3316 of `A` is computed. If `uplo = L` the lower Cholesky decomposition of `A`
3317 is computed. `A` is overwritten by its Cholesky decomposition. `B` is
3318 overwritten with the solution `X`.
3319 """
3320 posv!(uplo::AbstractChar, A::AbstractMatrix, B::AbstractVecOrMat)
3321
3322 """
3323 potrf!(uplo, A)
3324
3325 Computes the Cholesky (upper if `uplo = U`, lower if `uplo = L`)
3326 decomposition of positive-definite matrix `A`. `A` is overwritten and
3327 returned with an info code.
3328 """
3329 potrf!(uplo::AbstractChar, A::AbstractMatrix)
3330
3331 """
3332 potri!(uplo, A)
3333
3334 Computes the inverse of positive-definite matrix `A` after calling
3335 `potrf!` to find its (upper if `uplo = U`, lower if `uplo = L`) Cholesky
3336 decomposition.
3337
3338 `A` is overwritten by its inverse and returned.
3339 """
3340 potri!(uplo::AbstractChar, A::AbstractMatrix)
3341
3342 """
3343 potrs!(uplo, A, B)
3344
3345 Finds the solution to `A * X = B` where `A` is a symmetric or Hermitian
3346 positive definite matrix whose Cholesky decomposition was computed by
3347 `potrf!`. If `uplo = U` the upper Cholesky decomposition of `A` was
3348 computed. If `uplo = L` the lower Cholesky decomposition of `A` was
3349 computed. `B` is overwritten with the solution `X`.
3350 """
3351 potrs!(uplo::AbstractChar, A::AbstractMatrix, B::AbstractVecOrMat)
3352
3353 """
3354 pstrf!(uplo, A, tol) -> (A, piv, rank, info)
3355
3356 Computes the (upper if `uplo = U`, lower if `uplo = L`) pivoted Cholesky
3357 decomposition of positive-definite matrix `A` with a user-set tolerance
3358 `tol`. `A` is overwritten by its Cholesky decomposition.
3359
3360 Returns `A`, the pivots `piv`, the rank of `A`, and an `info` code. If `info = 0`,
3361 the factorization succeeded. If `info = i > 0 `, then `A` is indefinite or
3362 rank-deficient.
3363 """
3364 pstrf!(uplo::AbstractChar, A::AbstractMatrix, tol::Real)
3365
3366 # (PT) positive-definite, symmetric, tri-diagonal matrices
3367 # Direct solvers for general tridiagonal and symmetric positive-definite tridiagonal
3368 for (ptsv, pttrf, elty, relty) in
3369 ((:dptsv_,:dpttrf_,:Float64,:Float64),
3370 (:sptsv_,:spttrf_,:Float32,:Float32),
3371 (:zptsv_,:zpttrf_,:ComplexF64,:Float64),
3372 (:cptsv_,:cpttrf_,:ComplexF32,:Float32))
3373 @eval begin
3374 # SUBROUTINE DPTSV( N, NRHS, D, E, B, LDB, INFO )
3375 # .. Scalar Arguments ..
3376 # INTEGER INFO, LDB, N, NRHS
3377 # .. Array Arguments ..
3378 # DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
3379 function ptsv!(D::AbstractVector{$relty}, E::AbstractVector{$elty}, B::AbstractVecOrMat{$elty})
3380 require_one_based_indexing(D, E, B)
3381 chkstride1(B, D, E)
3382 n = length(D)
3383 if length(E) != n - 1
3384 throw(DimensionMismatch("E has length $(length(E)), but needs $(n - 1)"))
3385 end
3386 if n != size(B,1)
3387 throw(DimensionMismatch("B has first dimension $(size(B,1)) but needs $n"))
3388 end
3389 info = Ref{BlasInt}()
3390 ccall((@blasfunc($ptsv), libblastrampoline), Cvoid,
3391 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$relty}, Ptr{$elty},
3392 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
3393 n, size(B,2), D, E, B, max(1,stride(B,2)), info)
3394 chklapackerror(info[])
3395 B
3396 end
3397
3398 # SUBROUTINE DPTTRF( N, D, E, INFO )
3399 # .. Scalar Arguments ..
3400 # INTEGER INFO, N
3401 # .. Array Arguments ..
3402 # DOUBLE PRECISION D( * ), E( * )
3403 function pttrf!(D::AbstractVector{$relty}, E::AbstractVector{$elty})
3404 require_one_based_indexing(D, E)
3405 chkstride1(D, E)
3406 n = length(D)
3407 if length(E) != n - 1
3408 throw(DimensionMismatch("E has length $(length(E)), but needs $(n - 1)"))
3409 end
3410 info = Ref{BlasInt}()
3411 ccall((@blasfunc($pttrf), libblastrampoline), Cvoid,
3412 (Ref{BlasInt}, Ptr{$relty}, Ptr{$elty}, Ptr{BlasInt}),
3413 n, D, E, info)
3414 chklapackerror(info[])
3415 D, E
3416 end
3417 end
3418 end
3419
3420 """
3421 ptsv!(D, E, B)
3422
3423 Solves `A * X = B` for positive-definite tridiagonal `A`. `D` is the
3424 diagonal of `A` and `E` is the off-diagonal. `B` is overwritten with the
3425 solution `X` and returned.
3426 """
3427 ptsv!(D::AbstractVector, E::AbstractVector, B::AbstractVecOrMat)
3428
3429 """
3430 pttrf!(D, E)
3431
3432 Computes the LDLt factorization of a positive-definite tridiagonal matrix
3433 with `D` as diagonal and `E` as off-diagonal. `D` and `E` are overwritten
3434 and returned.
3435 """
3436 pttrf!(D::AbstractVector, E::AbstractVector)
3437
3438 for (pttrs, elty, relty) in
3439 ((:dpttrs_,:Float64,:Float64),
3440 (:spttrs_,:Float32,:Float32))
3441 @eval begin
3442 # SUBROUTINE DPTTRS( N, NRHS, D, E, B, LDB, INFO )
3443 # .. Scalar Arguments ..
3444 # INTEGER INFO, LDB, N, NRHS
3445 # .. Array Arguments ..
3446 # DOUBLE PRECISION B( LDB, * ), D( * ), E( * )
3447 function pttrs!(D::AbstractVector{$relty}, E::AbstractVector{$elty}, B::AbstractVecOrMat{$elty})
3448 require_one_based_indexing(D, E, B)
3449 chkstride1(B, D, E)
3450 n = length(D)
3451 if length(E) != n - 1
3452 throw(DimensionMismatch("E has length $(length(E)), but needs $(n - 1)"))
3453 end
3454 if n != size(B,1)
3455 throw(DimensionMismatch("B has first dimension $(size(B,1)) but needs $n"))
3456 end
3457 info = Ref{BlasInt}()
3458 ccall((@blasfunc($pttrs), libblastrampoline), Cvoid,
3459 (Ref{BlasInt}, Ref{BlasInt}, Ptr{$relty}, Ptr{$elty},
3460 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}),
3461 n, size(B,2), D, E, B, max(1,stride(B,2)), info)
3462 chklapackerror(info[])
3463 B
3464 end
3465 end
3466 end
3467
3468 for (pttrs, elty, relty) in
3469 ((:zpttrs_,:ComplexF64,:Float64),
3470 (:cpttrs_,:ComplexF32,:Float32))
3471 @eval begin
3472 # SUBROUTINE ZPTTRS( UPLO, N, NRHS, D, E, B, LDB, INFO )
3473 # * .. Scalar Arguments ..
3474 # CHARACTER UPLO
3475 # INTEGER INFO, LDB, N, NRHS
3476 # * ..
3477 # * .. Array Arguments ..
3478 # DOUBLE PRECISION D( * )
3479 # COMPLEX*16 B( LDB, * ), E( * )
3480 function pttrs!(uplo::AbstractChar, D::AbstractVector{$relty}, E::AbstractVector{$elty}, B::AbstractVecOrMat{$elty})
3481 require_one_based_indexing(D, E, B)
3482 chkstride1(B, D, E)
3483 chkuplo(uplo)
3484 n = length(D)
3485 if length(E) != n - 1
3486 throw(DimensionMismatch("E has length $(length(E)), but needs $(n - 1)"))
3487 end
3488 if n != size(B,1)
3489 throw(DimensionMismatch("B has first dimension $(size(B,1)) but needs $n"))
3490 end
3491 info = Ref{BlasInt}()
3492 ccall((@blasfunc($pttrs), libblastrampoline), Cvoid,
3493 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$relty}, Ptr{$elty},
3494 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
3495 uplo, n, size(B,2), D, E, B, max(1,stride(B,2)), info, 1)
3496 chklapackerror(info[])
3497 B
3498 end
3499 end
3500 end
3501
3502 """
3503 pttrs!(D, E, B)
3504
3505 Solves `A * X = B` for positive-definite tridiagonal `A` with diagonal
3506 `D` and off-diagonal `E` after computing `A`'s LDLt factorization using
3507 `pttrf!`. `B` is overwritten with the solution `X`.
3508 """
3509 pttrs!(D::AbstractVector, E::AbstractVector, B::AbstractVecOrMat)
3510
3511 ## (TR) triangular matrices: solver and inverse
3512 for (trtri, trtrs, elty) in
3513 ((:dtrtri_,:dtrtrs_,:Float64),
3514 (:strtri_,:strtrs_,:Float32),
3515 (:ztrtri_,:ztrtrs_,:ComplexF64),
3516 (:ctrtri_,:ctrtrs_,:ComplexF32))
3517 @eval begin
3518 # SUBROUTINE DTRTRI( UPLO, DIAG, N, A, LDA, INFO )
3519 #* .. Scalar Arguments ..
3520 # CHARACTER DIAG, UPLO
3521 # INTEGER INFO, LDA, N
3522 # .. Array Arguments ..
3523 # DOUBLE PRECISION A( LDA, * )
3524 function trtri!(uplo::AbstractChar, diag::AbstractChar, A::AbstractMatrix{$elty})
3525 chkstride1(A)
3526 n = checksquare(A)
3527 chkuplo(uplo)
3528 chkdiag(diag)
3529 lda = max(1,stride(A, 2))
3530 info = Ref{BlasInt}()
3531 ccall((@blasfunc($trtri), libblastrampoline), Cvoid,
3532 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3533 Ptr{BlasInt}, Clong, Clong),
3534 uplo, diag, n, A, lda, info, 1, 1)
3535 chklapackerror(info[])
3536 A
3537 end
3538
3539 # SUBROUTINE DTRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO )
3540 # * .. Scalar Arguments ..
3541 # CHARACTER DIAG, TRANS, UPLO
3542 # INTEGER INFO, LDA, LDB, N, NRHS
3543 # * .. Array Arguments ..
3544 # DOUBLE PRECISION A( LDA, * ), B( LDB, * )
3545 function trtrs!(uplo::AbstractChar, trans::AbstractChar, diag::AbstractChar,
3546 A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
3547 require_one_based_indexing(A, B)
3548 chktrans(trans)
3549 chkdiag(diag)
3550 chkstride1(A)
3551 n = checksquare(A)
3552 chkuplo(uplo)
3553 if n != size(B,1)
3554 throw(DimensionMismatch("B has first dimension $(size(B,1)) but needs $n"))
3555 end
3556 info = Ref{BlasInt}()
3557 ccall((@blasfunc($trtrs), libblastrampoline), Cvoid,
3558 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
3559 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
3560 Clong, Clong, Clong),
3561 uplo, trans, diag, n, size(B,2), A, max(1,stride(A,2)),
3562 B, max(1,stride(B,2)), info,
3563 1, 1, 1)
3564 chklapackerror(info[])
3565 B
3566 end
3567 end
3568 end
3569
3570 """
3571 trtri!(uplo, diag, A)
3572
3573 Finds the inverse of (upper if `uplo = U`, lower if `uplo = L`)
3574 triangular matrix `A`. If `diag = N`, `A` has non-unit diagonal elements.
3575 If `diag = U`, all diagonal elements of `A` are one. `A` is overwritten
3576 with its inverse.
3577 """
3578 trtri!(uplo::AbstractChar, diag::AbstractChar, A::AbstractMatrix)
3579
3580 """
3581 trtrs!(uplo, trans, diag, A, B)
3582
3583 Solves `A * X = B` (`trans = N`), `transpose(A) * X = B` (`trans = T`), or
3584 `adjoint(A) * X = B` (`trans = C`) for (upper if `uplo = U`, lower if `uplo = L`)
3585 triangular matrix `A`. If `diag = N`, `A` has non-unit diagonal elements.
3586 If `diag = U`, all diagonal elements of `A` are one. `B` is overwritten
3587 with the solution `X`.
3588 """
3589 trtrs!(uplo::AbstractChar, trans::AbstractChar, diag::AbstractChar, A::AbstractMatrix, B::AbstractVecOrMat)
3590
3591 #Eigenvector computation and condition number estimation
3592 for (trcon, trevc, trrfs, elty) in
3593 ((:dtrcon_,:dtrevc_,:dtrrfs_,:Float64),
3594 (:strcon_,:strevc_,:strrfs_,:Float32))
3595 @eval begin
3596 # SUBROUTINE DTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
3597 # IWORK, INFO )
3598 # .. Scalar Arguments ..
3599 # CHARACTER DIAG, NORM, UPLO
3600 # INTEGER INFO, LDA, N
3601 # DOUBLE PRECISION RCOND
3602 # .. Array Arguments ..
3603 # INTEGER IWORK( * )
3604 # DOUBLE PRECISION A( LDA, * ), WORK( * )
3605 function trcon!(norm::AbstractChar, uplo::AbstractChar, diag::AbstractChar, A::AbstractMatrix{$elty})
3606 chkstride1(A)
3607 chkdiag(diag)
3608 n = checksquare(A)
3609 chkuplo(uplo)
3610 rcond = Ref{$elty}()
3611 work = Vector{$elty}(undef, 3n)
3612 iwork = Vector{BlasInt}(undef, n)
3613 info = Ref{BlasInt}()
3614 ccall((@blasfunc($trcon), libblastrampoline), Cvoid,
3615 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
3616 Ptr{$elty}, Ref{BlasInt}, Ref{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt},
3617 Clong, Clong, Clong),
3618 norm, uplo, diag, n,
3619 A, max(1,stride(A,2)), rcond, work, iwork, info,
3620 1, 1, 1)
3621 chklapackerror(info[])
3622 rcond[]
3623 end
3624
3625 # SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
3626 # LDVR, MM, M, WORK, INFO )
3627 #
3628 # .. Scalar Arguments ..
3629 # CHARACTER HOWMNY, SIDE
3630 # INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
3631 # ..
3632 # .. Array Arguments ..
3633 # LOGICAL SELECT( * )
3634 # DOUBLE PRECISION T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
3635 #$ WORK( * )
3636 function trevc!(side::AbstractChar, howmny::AbstractChar, select::AbstractVector{BlasInt}, T::AbstractMatrix{$elty},
3637 VL::AbstractMatrix{$elty} = similar(T),
3638 VR::AbstractMatrix{$elty} = similar(T))
3639 require_one_based_indexing(select, T, VL, VR)
3640 # Extract
3641 if side ∉ ['L','R','B']
3642 throw(ArgumentError("side argument must be 'L' (left eigenvectors), 'R' (right eigenvectors), or 'B' (both), got $side"))
3643 end
3644 n, mm = checksquare(T), size(VL, 2)
3645 ldt, ldvl, ldvr = stride(T, 2), stride(VL, 2), stride(VR, 2)
3646
3647 # Check
3648 chkstride1(T, select, VL, VR)
3649
3650 # Allocate
3651 m = Ref{BlasInt}()
3652 work = Vector{$elty}(undef, 3n)
3653 info = Ref{BlasInt}()
3654
3655 ccall((@blasfunc($trevc), libblastrampoline), Cvoid,
3656 (Ref{UInt8}, Ref{UInt8}, Ptr{BlasInt}, Ref{BlasInt},
3657 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3658 Ptr{$elty}, Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
3659 Ptr{$elty}, Ptr{BlasInt}, Clong, Clong),
3660 side, howmny, select, n,
3661 T, ldt, VL, ldvl,
3662 VR, ldvr, mm, m,
3663 work, info, 1, 1)
3664 chklapackerror(info[])
3665
3666 #Decide what exactly to return
3667 if howmny == 'S' #compute selected eigenvectors
3668 if side == 'L' #left eigenvectors only
3669 return select, VL[:,1:m[]]
3670 elseif side == 'R' #right eigenvectors only
3671 return select, VR[:,1:m[]]
3672 else #side == 'B' #both eigenvectors
3673 return select, VL[:,1:m[]], VR[:,1:m[]]
3674 end
3675 else #compute all eigenvectors
3676 if side == 'L' #left eigenvectors only
3677 return VL[:,1:m[]]
3678 elseif side == 'R' #right eigenvectors only
3679 return VR[:,1:m[]]
3680 else #side == 'B' #both eigenvectors
3681 return VL[:,1:m[]], VR[:,1:m[]]
3682 end
3683 end
3684 end
3685
3686 # SUBROUTINE DTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
3687 # LDX, FERR, BERR, WORK, IWORK, INFO )
3688 # .. Scalar Arguments ..
3689 # CHARACTER DIAG, TRANS, UPLO
3690 # INTEGER INFO, LDA, LDB, LDX, N, NRHS
3691 # .. Array Arguments ..
3692 # INTEGER IWORK( * )
3693 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
3694 #$ WORK( * ), X( LDX, * )
3695 function trrfs!(uplo::AbstractChar, trans::AbstractChar, diag::AbstractChar,
3696 A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty}, X::AbstractVecOrMat{$elty},
3697 Ferr::AbstractVector{$elty} = similar(B, $elty, size(B,2)),
3698 Berr::AbstractVector{$elty} = similar(B, $elty, size(B,2)))
3699 require_one_based_indexing(A, B, X, Ferr, Berr)
3700 chkstride1(A, B, X, Ferr, Berr)
3701 chktrans(trans)
3702 chkuplo(uplo)
3703 chkdiag(diag)
3704 n = size(A,2)
3705 nrhs = size(B,2)
3706 if nrhs != size(X,2)
3707 throw(DimensionMismatch("second dimensions of B, $nrhs, and X, $(size(X,2)), must match"))
3708 end
3709 work = Vector{$elty}(undef, 3n)
3710 iwork = Vector{BlasInt}(undef, n)
3711 info = Ref{BlasInt}()
3712 ccall((@blasfunc($trrfs), libblastrampoline), Cvoid,
3713 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
3714 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3715 Ptr{$elty}, Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Clong, Clong, Clong),
3716 uplo, trans, diag, n,
3717 nrhs, A, max(1,stride(A,2)), B, max(1,stride(B,2)), X, max(1,stride(X,2)),
3718 Ferr, Berr, work, iwork, info, 1, 1, 1)
3719 chklapackerror(info[])
3720 Ferr, Berr
3721 end
3722 end
3723 end
3724
3725 for (trcon, trevc, trrfs, elty, relty) in
3726 ((:ztrcon_,:ztrevc_,:ztrrfs_,:ComplexF64,:Float64),
3727 (:ctrcon_,:ctrevc_,:ctrrfs_,:ComplexF32, :Float32))
3728 @eval begin
3729 # SUBROUTINE ZTRCON( NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK,
3730 # RWORK, INFO )
3731 # .. Scalar Arguments ..
3732 # CHARACTER DIAG, NORM, UPLO
3733 # INTEGER INFO, LDA, N
3734 # DOUBLE PRECISION RCOND
3735 # .. Array Arguments ..
3736 # DOUBLE PRECISION RWORK( * )
3737 # COMPLEX*16 A( LDA, * ), WORK( * )
3738 function trcon!(norm::AbstractChar, uplo::AbstractChar, diag::AbstractChar, A::AbstractMatrix{$elty})
3739 chkstride1(A)
3740 n = checksquare(A)
3741 chkuplo(uplo)
3742 chkdiag(diag)
3743 rcond = Ref{$relty}(1)
3744 work = Vector{$elty}(undef, 2n)
3745 rwork = Vector{$relty}(undef, n)
3746 info = Ref{BlasInt}()
3747 ccall((@blasfunc($trcon), libblastrampoline), Cvoid,
3748 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
3749 Ptr{$elty}, Ref{BlasInt}, Ref{$relty}, Ptr{$elty}, Ptr{$relty}, Ptr{BlasInt},
3750 Clong, Clong, Clong),
3751 norm, uplo, diag, n,
3752 A, max(1,stride(A,2)), rcond, work, rwork, info,
3753 1, 1, 1)
3754 chklapackerror(info[])
3755 rcond[]
3756 end
3757
3758 # SUBROUTINE ZTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
3759 # LDVR, MM, M, WORK, RWORK, INFO )
3760 #
3761 # .. Scalar Arguments ..
3762 # CHARACTER HOWMNY, SIDE
3763 # INTEGER INFO, LDT, LDVL, LDVR, M, MM, N
3764 # ..
3765 # .. Array Arguments ..
3766 # LOGICAL SELECT( * )
3767 # DOUBLE PRECISION RWORK( * )
3768 # COMPLEX*16 T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
3769 #$ WORK( * )
3770 function trevc!(side::AbstractChar, howmny::AbstractChar, select::AbstractVector{BlasInt}, T::AbstractMatrix{$elty},
3771 VL::AbstractMatrix{$elty} = similar(T),
3772 VR::AbstractMatrix{$elty} = similar(T))
3773 require_one_based_indexing(select, T, VL, VR)
3774 # Extract
3775 n, mm = checksquare(T), size(VL, 2)
3776 ldt, ldvl, ldvr = stride(T, 2), stride(VL, 2), stride(VR, 2)
3777
3778 # Check
3779 chkstride1(T, select, VL, VR)
3780 if side ∉ ['L','R','B']
3781 throw(ArgumentError("side argument must be 'L' (left eigenvectors), 'R' (right eigenvectors), or 'B' (both), got $side"))
3782 end
3783
3784 # Allocate
3785 m = Ref{BlasInt}()
3786 work = Vector{$elty}(undef, 2n)
3787 rwork = Vector{$relty}(undef, n)
3788 info = Ref{BlasInt}()
3789 ccall((@blasfunc($trevc), libblastrampoline), Cvoid,
3790 (Ref{UInt8}, Ref{UInt8}, Ptr{BlasInt}, Ref{BlasInt},
3791 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3792 Ptr{$elty}, Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
3793 Ptr{$elty}, Ptr{$relty}, Ptr{BlasInt}, Clong, Clong),
3794 side, howmny, select, n,
3795 T, ldt, VL, ldvl,
3796 VR, ldvr, mm, m,
3797 work, rwork, info, 1, 1)
3798 chklapackerror(info[])
3799
3800 #Decide what exactly to return
3801 if howmny == 'S' #compute selected eigenvectors
3802 if side == 'L' #left eigenvectors only
3803 return select, VL[:,1:m[]]
3804 elseif side == 'R' #right eigenvectors only
3805 return select, VR[:,1:m[]]
3806 else #side=='B' #both eigenvectors
3807 return select, VL[:,1:m[]], VR[:,1:m[]]
3808 end
3809 else #compute all eigenvectors
3810 if side == 'L' #left eigenvectors only
3811 return VL[:,1:m[]]
3812 elseif side == 'R' #right eigenvectors only
3813 return VR[:,1:m[]]
3814 else #side=='B' #both eigenvectors
3815 return VL[:,1:m[]], VR[:,1:m[]]
3816 end
3817 end
3818 end
3819
3820 # SUBROUTINE ZTRRFS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X,
3821 # LDX, FERR, BERR, WORK, IWORK, INFO )
3822 # .. Scalar Arguments ..
3823 # CHARACTER DIAG, TRANS, UPLO
3824 # INTEGER INFO, LDA, LDB, LDX, N, NRHS
3825 # .. Array Arguments ..
3826 # INTEGER IWORK( * )
3827 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), BERR( * ), FERR( * ),
3828 #$ WORK( * ), X( LDX, * )
3829 function trrfs!(uplo::AbstractChar, trans::AbstractChar, diag::AbstractChar,
3830 A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty}, X::AbstractVecOrMat{$elty},
3831 Ferr::AbstractVector{$relty} = similar(B, $relty, size(B,2)),
3832 Berr::AbstractVector{$relty} = similar(B, $relty, size(B,2)))
3833 require_one_based_indexing(A, B, X, Ferr, Berr)
3834 chkstride1(A, B, X, Ferr, Berr)
3835 chktrans(trans)
3836 chkuplo(uplo)
3837 chkdiag(diag)
3838 n = size(A,2)
3839 nrhs = size(B,2)
3840 if nrhs != size(X,2)
3841 throw(DimensionMismatch("second dimensions of B, $nrhs, and X, $(size(X,2)), must match"))
3842 end
3843 work = Vector{$elty}(undef, 2n)
3844 rwork = Vector{$relty}(undef, n)
3845 info = Ref{BlasInt}()
3846 ccall((@blasfunc($trrfs), libblastrampoline), Cvoid,
3847 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
3848 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
3849 Ptr{$relty}, Ptr{$relty}, Ptr{$elty}, Ptr{$relty}, Ptr{BlasInt}, Clong, Clong, Clong),
3850 uplo, trans, diag, n,
3851 nrhs, A, max(1,stride(A,2)), B, max(1,stride(B,2)), X, max(1,stride(X,2)),
3852 Ferr, Berr, work, rwork, info, 1, 1, 1)
3853 chklapackerror(info[])
3854 Ferr, Berr
3855 end
3856 end
3857 end
3858
3859 """
3860 trcon!(norm, uplo, diag, A)
3861
3862 Finds the reciprocal condition number of (upper if `uplo = U`, lower if
3863 `uplo = L`) triangular matrix `A`. If `diag = N`, `A` has non-unit
3864 diagonal elements. If `diag = U`, all diagonal elements of `A` are one.
3865 If `norm = I`, the condition number is found in the infinity norm. If
3866 `norm = O` or `1`, the condition number is found in the one norm.
3867 """
3868 trcon!(norm::AbstractChar, uplo::AbstractChar, diag::AbstractChar, A::AbstractMatrix)
3869
3870 """
3871 trevc!(side, howmny, select, T, VL = similar(T), VR = similar(T))
3872
3873 Finds the eigensystem of an upper triangular matrix `T`. If `side = R`,
3874 the right eigenvectors are computed. If `side = L`, the left
3875 eigenvectors are computed. If `side = B`, both sets are computed. If
3876 `howmny = A`, all eigenvectors are found. If `howmny = B`, all
3877 eigenvectors are found and backtransformed using `VL` and `VR`. If
3878 `howmny = S`, only the eigenvectors corresponding to the values in
3879 `select` are computed.
3880 """
3881 trevc!(side::AbstractChar, howmny::AbstractChar, select::AbstractVector{BlasInt}, T::AbstractMatrix,
3882 VL::AbstractMatrix = similar(T), VR::AbstractMatrix = similar(T))
3883
3884 """
3885 trrfs!(uplo, trans, diag, A, B, X, Ferr, Berr) -> (Ferr, Berr)
3886
3887 Estimates the error in the solution to `A * X = B` (`trans = N`),
3888 `transpose(A) * X = B` (`trans = T`), `adjoint(A) * X = B` (`trans = C`) for `side = L`,
3889 or the equivalent equations a right-handed `side = R` `X * A` after
3890 computing `X` using `trtrs!`. If `uplo = U`, `A` is upper triangular.
3891 If `uplo = L`, `A` is lower triangular. If `diag = N`, `A` has non-unit
3892 diagonal elements. If `diag = U`, all diagonal elements of `A` are one.
3893 `Ferr` and `Berr` are optional inputs. `Ferr` is the forward error and
3894 `Berr` is the backward error, each component-wise.
3895 """
3896 trrfs!(uplo::AbstractChar, trans::AbstractChar, diag::AbstractChar, A::AbstractMatrix, B::AbstractVecOrMat,
3897 X::AbstractVecOrMat, Ferr::AbstractVector, Berr::AbstractVector)
3898
3899 ## (ST) Symmetric tridiagonal - eigendecomposition
3900 for (stev, stebz, stegr, stein, elty) in
3901 ((:dstev_,:dstebz_,:dstegr_,:dstein_,:Float64),
3902 (:sstev_,:sstebz_,:sstegr_,:sstein_,:Float32)
3903 # , (:zstev_,:ComplexF64) Need to rewrite for ZHEEV, rwork, etc.
3904 # , (:cstev_,:ComplexF32)
3905 )
3906 @eval begin
3907 function stev!(job::AbstractChar, dv::AbstractVector{$elty}, ev::AbstractVector{$elty})
3908 require_one_based_indexing(dv, ev)
3909 chkstride1(dv, ev)
3910 n = length(dv)
3911 if length(ev) != n - 1 && length(ev) != n
3912 throw(DimensionMismatch("ev has length $(length(ev)) but needs one less than or equal to dv's length, $n)"))
3913 end
3914 Zmat = similar(dv, $elty, (n, job != 'N' ? n : 0))
3915 work = Vector{$elty}(undef, max(1, 2n-2))
3916 info = Ref{BlasInt}()
3917 ccall((@blasfunc($stev), libblastrampoline), Cvoid,
3918 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
3919 Ref{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong),
3920 job, n, dv, ev, Zmat, n, work, info, 1)
3921 chklapackerror(info[])
3922 dv, Zmat
3923 end
3924
3925 #* DSTEBZ computes the eigenvalues of a symmetric tridiagonal
3926 #* matrix T. The user may ask for all eigenvalues, all eigenvalues
3927 #* in the half-open interval (VL, VU], or the IL-th through IU-th
3928 #* eigenvalues.
3929 function stebz!(range::AbstractChar, order::AbstractChar, vl::$elty, vu::$elty, il::Integer, iu::Integer, abstol::Real, dv::AbstractVector{$elty}, ev::AbstractVector{$elty})
3930 require_one_based_indexing(dv, ev)
3931 chkstride1(dv, ev)
3932 n = length(dv)
3933 if length(ev) != n - 1
3934 throw(DimensionMismatch("ev has length $(length(ev)) but needs one less than dv's length, $n)"))
3935 end
3936 m = Ref{BlasInt}()
3937 nsplit = Vector{BlasInt}(undef, 1)
3938 w = similar(dv, $elty, n)
3939 tmp = 0.0
3940 iblock = similar(dv, BlasInt,n)
3941 isplit = similar(dv, BlasInt,n)
3942 work = Vector{$elty}(undef, 4*n)
3943 iwork = Vector{BlasInt}(undef, 3*n)
3944 info = Ref{BlasInt}()
3945 ccall((@blasfunc($stebz), libblastrampoline), Cvoid,
3946 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{$elty},
3947 Ref{$elty}, Ref{BlasInt}, Ref{BlasInt}, Ref{$elty},
3948 Ptr{$elty}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt},
3949 Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty},
3950 Ptr{BlasInt}, Ptr{BlasInt}, Clong, Clong),
3951 range, order, n, vl,
3952 vu, il, iu, abstol,
3953 dv, ev, m, nsplit,
3954 w, iblock, isplit, work,
3955 iwork, info, 1, 1)
3956 chklapackerror(info[])
3957 w[1:m[]], iblock[1:m[]], isplit[1:nsplit[1]]
3958 end
3959
3960 function stegr!(jobz::AbstractChar, range::AbstractChar, dv::AbstractVector{$elty}, ev::AbstractVector{$elty}, vl::Real, vu::Real, il::Integer, iu::Integer)
3961 require_one_based_indexing(dv, ev)
3962 chkstride1(dv, ev)
3963 n = length(dv)
3964 ne = length(ev)
3965 if ne == n - 1
3966 eev = [ev; zero($elty)]
3967 elseif ne == n
3968 eev = copy(ev)
3969 eev[n] = zero($elty)
3970 else
3971 throw(DimensionMismatch("ev has length $ne but needs one less than or equal to dv's length, $n)"))
3972 end
3973
3974 abstol = Vector{$elty}(undef, 1)
3975 m = Ref{BlasInt}()
3976 w = similar(dv, $elty, n)
3977 ldz = jobz == 'N' ? 1 : n
3978 Z = similar(dv, $elty, ldz, range == 'I' ? iu-il+1 : n)
3979 isuppz = similar(dv, BlasInt, 2*size(Z, 2))
3980 work = Vector{$elty}(undef, 1)
3981 lwork = BlasInt(-1)
3982 iwork = Vector{BlasInt}(undef, 1)
3983 liwork = BlasInt(-1)
3984 info = Ref{BlasInt}()
3985 for i = 1:2 # first call returns lwork as work[1] and liwork as iwork[1]
3986 ccall((@blasfunc($stegr), libblastrampoline), Cvoid,
3987 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
3988 Ptr{$elty}, Ref{$elty}, Ref{$elty}, Ref{BlasInt},
3989 Ref{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty},
3990 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{$elty},
3991 Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
3992 Clong, Clong),
3993 jobz, range, n, dv,
3994 eev, vl, vu, il,
3995 iu, abstol, m, w,
3996 Z, ldz, isuppz, work,
3997 lwork, iwork, liwork, info,
3998 1, 1)
3999 chklapackerror(info[])
4000 if i == 1
4001 lwork = BlasInt(work[1])
4002 resize!(work, lwork)
4003 liwork = iwork[1]
4004 resize!(iwork, liwork)
4005 end
4006 end
4007 m[] == length(w) ? w : w[1:m[]], m[] == size(Z, 2) ? Z : Z[:,1:m[]]
4008 end
4009
4010 function stein!(dv::AbstractVector{$elty}, ev_in::AbstractVector{$elty}, w_in::AbstractVector{$elty}, iblock_in::AbstractVector{BlasInt}, isplit_in::AbstractVector{BlasInt})
4011 require_one_based_indexing(dv, ev_in, w_in, iblock_in, isplit_in)
4012 chkstride1(dv, ev_in, w_in, iblock_in, isplit_in)
4013 n = length(dv)
4014 ne = length(ev_in)
4015 if ne == n - 1
4016 ev = [ev_in; zero($elty)]
4017 elseif ne == n
4018 ev = copy(ev_in)
4019 ev[n] = zero($elty)
4020 else
4021 throw(DimensionMismatch("ev_in has length $ne but needs one less than or equal to dv's length, $n)"))
4022 end
4023 ldz = n #Leading dimension
4024 #Number of eigenvalues to find
4025 if !(1 <= length(w_in) <= n)
4026 throw(DimensionMismatch("w_in has length $(length(w_in)), but needs to be between 1 and $n"))
4027 end
4028 m = length(w_in)
4029 #If iblock and isplit are invalid input, assume worst-case block partitioning,
4030 # i.e. set the block scheme to be the entire matrix
4031 iblock = similar(dv, BlasInt,n)
4032 isplit = similar(dv, BlasInt,n)
4033 w = similar(dv, $elty,n)
4034 if length(iblock_in) < m #Not enough block specifications
4035 iblock[1:m] = fill(BlasInt(1), m)
4036 w[1:m] = sort(w_in)
4037 else
4038 iblock[1:m] = iblock_in
4039 w[1:m] = w_in #Assume user has sorted the eigenvalues properly
4040 end
4041 if length(isplit_in) < 1 #Not enough block specifications
4042 isplit[1] = n
4043 else
4044 isplit[1:length(isplit_in)] = isplit_in
4045 end
4046 z = similar(dv, $elty,(n,m))
4047 work = Vector{$elty}(undef, 5*n)
4048 iwork = Vector{BlasInt}(undef, n)
4049 ifail = Vector{BlasInt}(undef, m)
4050 info = Ref{BlasInt}()
4051 ccall((@blasfunc($stein), libblastrampoline), Cvoid,
4052 (Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
4053 Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Ptr{$elty},
4054 Ref{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt},
4055 Ptr{BlasInt}),
4056 n, dv, ev, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
4057 chklapackerror(info[])
4058 if any(ifail .!= 0)
4059 # TODO: better error message / type
4060 error("failed to converge eigenvectors:\n$(findall(!iszero, ifail))")
4061 end
4062 z
4063 end
4064 end
4065 end
4066 stegr!(jobz::AbstractChar, dv::AbstractVector, ev::AbstractVector) = stegr!(jobz, 'A', dv, ev, 0.0, 0.0, 0, 0)
4067
4068 # Allow user to skip specification of iblock and isplit
4069 stein!(dv::AbstractVector, ev::AbstractVector, w_in::AbstractVector) = stein!(dv, ev, w_in, zeros(BlasInt,0), zeros(BlasInt,0))
4070 # Allow user to specify just one eigenvector to get in stein!
4071 stein!(dv::AbstractVector, ev::AbstractVector, eval::Real) = stein!(dv, ev, [eval], zeros(BlasInt,0), zeros(BlasInt,0))
4072
4073 """
4074 stev!(job, dv, ev) -> (dv, Zmat)
4075
4076 Computes the eigensystem for a symmetric tridiagonal matrix with `dv` as
4077 diagonal and `ev` as off-diagonal. If `job = N` only the eigenvalues are
4078 found and returned in `dv`. If `job = V` then the eigenvectors are also found
4079 and returned in `Zmat`.
4080 """
4081 stev!(job::AbstractChar, dv::AbstractVector, ev::AbstractVector)
4082
4083 """
4084 stebz!(range, order, vl, vu, il, iu, abstol, dv, ev) -> (dv, iblock, isplit)
4085
4086 Computes the eigenvalues for a symmetric tridiagonal matrix with `dv` as
4087 diagonal and `ev` as off-diagonal. If `range = A`, all the eigenvalues
4088 are found. If `range = V`, the eigenvalues in the half-open interval
4089 `(vl, vu]` are found. If `range = I`, the eigenvalues with indices between
4090 `il` and `iu` are found. If `order = B`, eigvalues are ordered within a
4091 block. If `order = E`, they are ordered across all the blocks.
4092 `abstol` can be set as a tolerance for convergence.
4093 """
4094 stebz!(range::AbstractChar, order::AbstractChar, vl, vu, il::Integer, iu::Integer, abstol::Real, dv::AbstractVector, ev::AbstractVector)
4095
4096 """
4097 stegr!(jobz, range, dv, ev, vl, vu, il, iu) -> (w, Z)
4098
4099 Computes the eigenvalues (`jobz = N`) or eigenvalues and eigenvectors
4100 (`jobz = V`) for a symmetric tridiagonal matrix with `dv` as diagonal
4101 and `ev` as off-diagonal. If `range = A`, all the eigenvalues
4102 are found. If `range = V`, the eigenvalues in the half-open interval
4103 `(vl, vu]` are found. If `range = I`, the eigenvalues with indices between
4104 `il` and `iu` are found. The eigenvalues are returned in `w` and the eigenvectors
4105 in `Z`.
4106 """
4107 stegr!(jobz::AbstractChar, range::AbstractChar, dv::AbstractVector, ev::AbstractVector, vl::Real, vu::Real, il::Integer, iu::Integer)
4108
4109 """
4110 stein!(dv, ev_in, w_in, iblock_in, isplit_in)
4111
4112 Computes the eigenvectors for a symmetric tridiagonal matrix with `dv`
4113 as diagonal and `ev_in` as off-diagonal. `w_in` specifies the input
4114 eigenvalues for which to find corresponding eigenvectors. `iblock_in`
4115 specifies the submatrices corresponding to the eigenvalues in `w_in`.
4116 `isplit_in` specifies the splitting points between the submatrix blocks.
4117 """
4118 stein!(dv::AbstractVector, ev_in::AbstractVector, w_in::AbstractVector, iblock_in::AbstractVector{BlasInt}, isplit_in::AbstractVector{BlasInt})
4119
4120 ## (SY) symmetric real matrices - Bunch-Kaufman decomposition,
4121 ## solvers (direct and factored) and inverse.
4122 for (syconv, sysv, sytrf, sytri, sytrs, elty) in
4123 ((:dsyconv_,:dsysv_,:dsytrf_,:dsytri_,:dsytrs_,:Float64),
4124 (:ssyconv_,:ssysv_,:ssytrf_,:ssytri_,:ssytrs_,:Float32))
4125 @eval begin
4126 # SUBROUTINE DSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
4127 # * .. Scalar Arguments ..
4128 # CHARACTER UPLO, WAY
4129 # INTEGER INFO, LDA, N
4130 # * .. Array Arguments ..
4131 # INTEGER IPIV( * )
4132 # DOUBLE PRECISION A( LDA, * ), WORK( * )
4133 function syconv!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4134 chkstride1(A, ipiv)
4135 n = checksquare(A)
4136 chkuplo(uplo)
4137 work = Vector{$elty}(undef, n)
4138 info = Ref{BlasInt}()
4139 ccall((@blasfunc($syconv), libblastrampoline), Cvoid,
4140 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4141 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong, Clong),
4142 uplo, 'C', n, A, max(1,stride(A,2)), ipiv, work, info, 1, 1)
4143 chklapackerror(info[])
4144 A, work
4145 end
4146
4147 # SUBROUTINE DSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
4148 # LWORK, INFO )
4149 # .. Scalar Arguments ..
4150 # CHARACTER UPLO
4151 # INTEGER INFO, LDA, LDB, LWORK, N, NRHS
4152 # .. Array Arguments ..
4153 # INTEGER IPIV( * )
4154 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
4155 function sysv!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
4156 require_one_based_indexing(A, B)
4157 chkstride1(A,B)
4158 n = checksquare(A)
4159 chkuplo(uplo)
4160 if n != size(B,1)
4161 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4162 end
4163 ipiv = similar(A, BlasInt, n)
4164 work = Vector{$elty}(undef, 1)
4165 lwork = BlasInt(-1)
4166 info = Ref{BlasInt}()
4167 for i = 1:2 # first call returns lwork as work[1]
4168 ccall((@blasfunc($sysv), libblastrampoline), Cvoid,
4169 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
4170 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4171 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)),
4172 work, lwork, info, 1)
4173 chkargsok(info[])
4174 chknonsingular(info[])
4175 if i == 1
4176 lwork = BlasInt(real(work[1]))
4177 resize!(work, lwork)
4178 end
4179 end
4180 B, A, ipiv
4181 end
4182
4183 # SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4184 # * .. Scalar Arguments ..
4185 # CHARACTER UPLO
4186 # INTEGER INFO, LDA, LWORK, N
4187 # * .. Array Arguments ..
4188 # INTEGER IPIV( * )
4189 # DOUBLE PRECISION A( LDA, * ), WORK( * )
4190 function sytrf!(uplo::AbstractChar, A::AbstractMatrix{$elty})
4191 chkstride1(A)
4192 n = checksquare(A)
4193 chkuplo(uplo)
4194 ipiv = similar(A, BlasInt, n)
4195 if n == 0
4196 return A, ipiv, zero(BlasInt)
4197 end
4198 work = Vector{$elty}(undef, 1)
4199 lwork = BlasInt(-1)
4200 info = Ref{BlasInt}()
4201 for i = 1:2 # first call returns lwork as work[1]
4202 ccall((@blasfunc($sytrf), libblastrampoline), Cvoid,
4203 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4204 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4205 uplo, n, A, stride(A,2), ipiv, work, lwork, info, 1)
4206 chkargsok(info[])
4207 if i == 1
4208 lwork = BlasInt(real(work[1]))
4209 resize!(work, lwork)
4210 end
4211 end
4212 return A, ipiv, info[]
4213 end
4214
4215 # SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4216 # * .. Scalar Arguments ..
4217 # CHARACTER UPLO
4218 # INTEGER INFO, LDA, LWORK, N
4219 # * .. Array Arguments ..
4220 # INTEGER IPIV( * )
4221 # DOUBLE PRECISION A( LDA, * ), WORK( * )
4222 # function sytri!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::Vector{BlasInt})
4223 # chkstride1(A)
4224 # n = checksquare(A)
4225 # chkuplo(uplo)
4226 # work = Vector{$elty}(undef, 1)
4227 # lwork = BlasInt(-1)
4228 # info = Ref{BlasInt}()
4229 # for i in 1:2
4230 # ccall((@blasfunc($sytri), libblastrampoline), Cvoid,
4231 # (Ptr{UInt8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt},
4232 # Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Clong),
4233 # &uplo, &n, A, &max(1,stride(A,2)), ipiv, work, &lwork, info, 1)
4234 # @assertargsok
4235 # chknonsingular(info[])
4236 # if lwork < 0
4237 # lwork = BlasInt(real(work[1]))
4238 # work = Vector{$elty}(undef, lwork)
4239 # end
4240 # end
4241 # A
4242 # end
4243
4244 # SUBROUTINE DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
4245 # .. Scalar Arguments ..
4246 # CHARACTER UPLO
4247 # INTEGER INFO, LDA, N
4248 # .. Array Arguments ..
4249 # INTEGER IPIV( * )
4250 # DOUBLE PRECISION A( LDA, * ), WORK( * )
4251 function sytri!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4252 chkstride1(A, ipiv)
4253 n = checksquare(A)
4254 chkuplo(uplo)
4255 work = Vector{$elty}(undef, n)
4256 info = Ref{BlasInt}()
4257 ccall((@blasfunc($sytri), libblastrampoline), Cvoid,
4258 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4259 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong),
4260 uplo, n, A, max(1,stride(A,2)), ipiv, work, info, 1)
4261 chkargsok(info[])
4262 chknonsingular(info[])
4263 A
4264 end
4265
4266 # SUBROUTINE DSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
4267 #
4268 # .. Scalar Arguments ..
4269 # CHARACTER UPLO
4270 # INTEGER INFO, LDA, LDB, N, NRHS
4271 # .. Array Arguments ..
4272 # INTEGER IPIV( * )
4273 # DOUBLE PRECISION A( LDA, * ), B( LDB, * )
4274 function sytrs!(uplo::AbstractChar, A::AbstractMatrix{$elty},
4275 ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat{$elty})
4276 require_one_based_indexing(A, ipiv, B)
4277 chkstride1(A,B,ipiv)
4278 n = checksquare(A)
4279 chkuplo(uplo)
4280 if n != size(B,1)
4281 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4282 end
4283 info = Ref{BlasInt}()
4284 ccall((@blasfunc($sytrs), libblastrampoline), Cvoid,
4285 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4286 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4287 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info, 1)
4288 chklapackerror(info[])
4289 B
4290 end
4291 end
4292 end
4293
4294 # Rook-pivoting variants of symmetric-matrix algorithms
4295 for (sysv, sytrf, sytri, sytrs, syconvf, elty) in
4296 ((:dsysv_rook_,:dsytrf_rook_,:dsytri_rook_,:dsytrs_rook_,:dsyconvf_rook_,:Float64),
4297 (:ssysv_rook_,:ssytrf_rook_,:ssytri_rook_,:ssytrs_rook_,:ssyconvf_rook_,:Float32))
4298 @eval begin
4299 # SUBROUTINE DSYSV_ROOK(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
4300 # LWORK, INFO )
4301 # .. Scalar Arguments ..
4302 # CHARACTER UPLO
4303 # INTEGER INFO, LDA, LDB, LWORK, N, NRHS
4304 # .. Array Arguments ..
4305 # INTEGER IPIV( * )
4306 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
4307 function sysv_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
4308 require_one_based_indexing(A, B)
4309 chkstride1(A,B)
4310 n = checksquare(A)
4311 chkuplo(uplo)
4312 if n != size(B,1)
4313 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4314 end
4315 ipiv = similar(A, BlasInt, n)
4316 work = Vector{$elty}(undef, 1)
4317 lwork = BlasInt(-1)
4318 info = Ref{BlasInt}()
4319 for i = 1:2 # first call returns lwork as work[1]
4320 ccall((@blasfunc($sysv), libblastrampoline), Cvoid,
4321 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
4322 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4323 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)),
4324 work, lwork, info, 1)
4325 chkargsok(info[])
4326 chknonsingular(info[])
4327 if i == 1
4328 lwork = BlasInt(real(work[1]))
4329 resize!(work, lwork)
4330 end
4331 end
4332 B, A, ipiv
4333 end
4334
4335 # SUBROUTINE DSYTRF_ROOK(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4336 # * .. Scalar Arguments ..
4337 # CHARACTER UPLO
4338 # INTEGER INFO, LDA, LWORK, N
4339 # * .. Array Arguments ..
4340 # INTEGER IPIV( * )
4341 # DOUBLE PRECISION A( LDA, * ), WORK( * )
4342 function sytrf_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty})
4343 chkstride1(A)
4344 n = checksquare(A)
4345 chkuplo(uplo)
4346 ipiv = similar(A, BlasInt, n)
4347 if n == 0
4348 return A, ipiv, zero(BlasInt)
4349 end
4350 work = Vector{$elty}(undef, 1)
4351 lwork = BlasInt(-1)
4352 info = Ref{BlasInt}()
4353 for i = 1:2 # first call returns lwork as work[1]
4354 ccall((@blasfunc($sytrf), libblastrampoline), Cvoid,
4355 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4356 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4357 uplo, n, A, stride(A,2), ipiv, work, lwork, info, 1)
4358 chkargsok(info[])
4359 if i == 1
4360 lwork = BlasInt(real(work[1]))
4361 resize!(work, lwork)
4362 end
4363 end
4364 return A, ipiv, info[]
4365 end
4366
4367 # SUBROUTINE DSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO )
4368 # .. Scalar Arguments ..
4369 # CHARACTER UPLO
4370 # INTEGER INFO, LDA, N
4371 # .. Array Arguments ..
4372 # INTEGER IPIV( * )
4373 # DOUBLE PRECISION A( LDA, * ), WORK( * )
4374 function sytri_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4375 chkstride1(A, ipiv)
4376 n = checksquare(A)
4377 chkuplo(uplo)
4378 work = Vector{$elty}(undef, n)
4379 info = Ref{BlasInt}()
4380 ccall((@blasfunc($sytri), libblastrampoline), Cvoid,
4381 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4382 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong),
4383 uplo, n, A, max(1,stride(A,2)), ipiv, work, info, 1)
4384 chkargsok(info[])
4385 chknonsingular(info[])
4386 A
4387 end
4388
4389 # SUBROUTINE DSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
4390 #
4391 # .. Scalar Arguments ..
4392 # CHARACTER UPLO
4393 # INTEGER INFO, LDA, LDB, N, NRHS
4394 # .. Array Arguments ..
4395 # INTEGER IPIV( * )
4396 # DOUBLE PRECISION A( LDA, * ), B( LDB, * )
4397 function sytrs_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty},
4398 ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat{$elty})
4399 require_one_based_indexing(A, ipiv, B)
4400 chkstride1(A,B,ipiv)
4401 n = checksquare(A)
4402 chkuplo(uplo)
4403 if n != size(B,1)
4404 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4405 end
4406 info = Ref{BlasInt}()
4407 ccall((@blasfunc($sytrs), libblastrampoline), Cvoid,
4408 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4409 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4410 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info, 1)
4411 chklapackerror(info[])
4412 B
4413 end
4414
4415 # SUBROUTINE DSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
4416 #
4417 # .. Scalar Arguments ..
4418 # CHARACTER UPLO, WAY
4419 # INTEGER INFO, LDA, N
4420 # ..
4421 # .. Array Arguments ..
4422 # INTEGER IPIV( * )
4423 # DOUBLE PRECISION A( LDA, * ), E( * )
4424 function syconvf_rook!(uplo::AbstractChar, way::AbstractChar,
4425 A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt},
4426 e::AbstractVector{$elty} = Vector{$elty}(undef, length(ipiv)))
4427 require_one_based_indexing(A, ipiv, e)
4428 # extract
4429 n = checksquare(A)
4430 lda = max(1, stride(A, 2))
4431
4432 # check
4433 chkuplo(uplo)
4434 if way != 'C' && way != 'R'
4435 throw(ArgumentError("way must be C or R"))
4436 end
4437 if length(ipiv) != n
4438 throw(ArgumentError("length of pivot vector was $(length(ipiv)) but should have been $n"))
4439 end
4440 if length(e) != n
4441 throw(ArgumentError("length of e vector was $(length(e)) but should have been $n"))
4442 end
4443
4444 # allocate
4445 info = Ref{BlasInt}()
4446
4447 ccall((@blasfunc($syconvf), libblastrampoline), Cvoid,
4448 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
4449 Ref{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt},
4450 Clong, Clong),
4451 uplo, way, n, A,
4452 lda, e, ipiv, info,
4453 1, 1)
4454
4455 chklapackerror(info[])
4456 return A, e
4457 end
4458 end
4459 end
4460
4461 ## (SY) hermitian matrices - eigendecomposition, Bunch-Kaufman decomposition,
4462 ## solvers (direct and factored) and inverse.
4463 for (syconv, hesv, hetrf, hetri, hetrs, elty, relty) in
4464 ((:zsyconv_,:zhesv_,:zhetrf_,:zhetri_,:zhetrs_,:ComplexF64, :Float64),
4465 (:csyconv_,:chesv_,:chetrf_,:chetri_,:chetrs_,:ComplexF32, :Float32))
4466 @eval begin
4467 # SUBROUTINE ZSYCONV( UPLO, WAY, N, A, LDA, IPIV, WORK, INFO )
4468 #
4469 # .. Scalar Arguments ..
4470 # CHARACTER UPLO, WAY
4471 # INTEGER INFO, LDA, N
4472 # ..
4473 # .. Array Arguments ..
4474 # INTEGER IPIV( * )
4475 # COMPLEX*16 A( LDA, * ), WORK( * )
4476 function syconv!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4477 chkstride1(A,ipiv)
4478 n = checksquare(A)
4479 chkuplo(uplo)
4480 work = Vector{$elty}(undef, n)
4481 info = Ref{BlasInt}()
4482 ccall((@blasfunc($syconv), libblastrampoline), Cvoid,
4483 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4484 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong, Clong),
4485 uplo, 'C', n, A, max(1,stride(A,2)), ipiv, work, info, 1, 1)
4486 chklapackerror(info[])
4487 A, work
4488 end
4489
4490 # SUBROUTINE ZHESV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
4491 # * .. Scalar Arguments ..
4492 # CHARACTER UPLO
4493 # INTEGER INFO, LDA, LDB, LWORK, N, NRHS
4494 # * ..
4495 # * .. Array Arguments ..
4496 # INTEGER IPIV( * )
4497 # COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
4498 function hesv!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
4499 require_one_based_indexing(A, B)
4500 chkstride1(A,B)
4501 n = checksquare(A)
4502 chkuplo(uplo)
4503 if n != size(B,1)
4504 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4505 end
4506 ipiv = similar(A, BlasInt, n)
4507 work = Vector{$elty}(undef, 1)
4508 lwork = BlasInt(-1)
4509 info = Ref{BlasInt}()
4510 for i = 1:2 # first call returns lwork as work[1]
4511 ccall((@blasfunc($hesv), libblastrampoline), Cvoid,
4512 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
4513 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4514 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)),
4515 work, lwork, info, 1)
4516 chklapackerror(info[])
4517 if i == 1
4518 lwork = BlasInt(real(work[1]))
4519 resize!(work, lwork)
4520 end
4521 end
4522 B, A, ipiv
4523 end
4524
4525 # SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4526 # * .. Scalar Arguments ..
4527 # CHARACTER UPLO
4528 # INTEGER INFO, LDA, LWORK, N
4529 # * ..
4530 # * .. Array Arguments ..
4531 # INTEGER IPIV( * )
4532 # COMPLEX*16 A( LDA, * ), WORK( * )
4533 function hetrf!(uplo::AbstractChar, A::AbstractMatrix{$elty})
4534 chkstride1(A)
4535 n = checksquare(A)
4536 chkuplo(uplo)
4537 ipiv = similar(A, BlasInt, n)
4538 work = Vector{$elty}(undef, 1)
4539 lwork = BlasInt(-1)
4540 info = Ref{BlasInt}()
4541 for i in 1:2 # first call returns lwork as work[1]
4542 ccall((@blasfunc($hetrf), libblastrampoline), Cvoid,
4543 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4544 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4545 uplo, n, A, max(1,stride(A,2)), ipiv, work, lwork, info, 1)
4546 chkargsok(info[])
4547 if i == 1
4548 lwork = BlasInt(real(work[1]))
4549 resize!(work, lwork)
4550 end
4551 end
4552 A, ipiv, info[]
4553 end
4554
4555 # SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4556 # * .. Scalar Arguments ..
4557 # CHARACTER UPLO
4558 # INTEGER INFO, LDA, LWORK, N
4559 # * ..
4560 # * .. Array Arguments ..
4561 # INTEGER IPIV( * )
4562 # COMPLEX*16 A( LDA, * ), WORK( * )
4563 # function hetri!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::Vector{BlasInt})
4564 # chkstride1(A)
4565 # n = checksquare(A)
4566 # chkuplo(uplo)
4567 # work = Vector{$elty}(undef, 1)
4568 # lwork = BlasInt(-1)
4569 # info = Ref{BlasInt}()
4570 # for i in 1:2
4571 # ccall((@blasfunc($hetri), libblastrampoline), Cvoid,
4572 # (Ptr{UInt8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt},
4573 # Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Clong),
4574 # &uplo, &n, A, &max(1,stride(A,2)), ipiv, work, &lwork, info, 1)
4575 # chklapackerror(info[])
4576 # if lwork < 0
4577 # lwork = BlasInt(real(work[1]))
4578 # work = Vector{$elty}(undef, lwork)
4579 # end
4580 # end
4581 # A
4582 # end
4583
4584
4585 # SUBROUTINE ZHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
4586 # * .. Scalar Arguments ..
4587 # CHARACTER UPLO
4588 # INTEGER INFO, LDA, N
4589 # * ..
4590 # * .. Array Arguments ..
4591 # INTEGER IPIV( * )
4592 # COMPLEX*16 A( LDA, * ), WORK( * )
4593 function hetri!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4594 chkstride1(A, ipiv)
4595 n = checksquare(A)
4596 chkuplo(uplo)
4597 work = Vector{$elty}(undef, n)
4598 info = Ref{BlasInt}()
4599 ccall((@blasfunc($hetri), libblastrampoline), Cvoid,
4600 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4601 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong),
4602 uplo, n, A, max(1,stride(A,2)), ipiv, work, info, 1)
4603 chklapackerror(info[])
4604 A
4605 end
4606
4607 # SUBROUTINE ZHETRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
4608 # * .. Scalar Arguments ..
4609 # CHARACTER UPLO
4610 # INTEGER INFO, LDA, LDB, N, NRHS
4611 # * ..
4612 # * .. Array Arguments ..
4613 # INTEGER IPIV( * )
4614 # COMPLEX*16 A( LDA, * ), B( LDB, * )
4615 function hetrs!(uplo::AbstractChar, A::AbstractMatrix{$elty},
4616 ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat{$elty})
4617 require_one_based_indexing(A, ipiv, B)
4618 chkstride1(A,B,ipiv)
4619 n = checksquare(A)
4620 if n != size(B,1)
4621 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4622 end
4623 info = Ref{BlasInt}()
4624 ccall((@blasfunc($hetrs), libblastrampoline), Cvoid,
4625 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4626 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4627 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info, 1)
4628 chklapackerror(info[])
4629 B
4630 end
4631 end
4632 end
4633
4634 for (hesv, hetrf, hetri, hetrs, elty, relty) in
4635 ((:zhesv_rook_,:zhetrf_rook_,:zhetri_rook_,:zhetrs_rook_,:ComplexF64, :Float64),
4636 (:chesv_rook_,:chetrf_rook_,:chetri_rook_,:chetrs_rook_,:ComplexF32, :Float32))
4637 @eval begin
4638 # SUBROUTINE ZHESV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
4639 # * .. Scalar Arguments ..
4640 # CHARACTER UPLO
4641 # INTEGER INFO, LDA, LDB, LWORK, N, NRHS
4642 # * ..
4643 # * .. Array Arguments ..
4644 # INTEGER IPIV( * )
4645 # COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
4646 function hesv_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
4647 require_one_based_indexing(A, B)
4648 chkstride1(A,B)
4649 n = checksquare(A)
4650 chkuplo(uplo)
4651 if n != size(B,1)
4652 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4653 end
4654 ipiv = similar(A, BlasInt, n)
4655 work = Vector{$elty}(undef, 1)
4656 lwork = BlasInt(-1)
4657 info = Ref{BlasInt}()
4658 for i = 1:2 # first call returns lwork as work[1]
4659 ccall((@blasfunc($hesv), libblastrampoline), Cvoid,
4660 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
4661 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4662 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)),
4663 work, lwork, info, 1)
4664 chklapackerror(info[])
4665 if i == 1
4666 lwork = BlasInt(real(work[1]))
4667 resize!(work, lwork)
4668 end
4669 end
4670 B, A, ipiv
4671 end
4672
4673 # SUBROUTINE ZHETRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4674 # * .. Scalar Arguments ..
4675 # CHARACTER UPLO
4676 # INTEGER INFO, LDA, LWORK, N
4677 # * ..
4678 # * .. Array Arguments ..
4679 # INTEGER IPIV( * )
4680 # COMPLEX*16 A( LDA, * ), WORK( * )
4681 function hetrf_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty})
4682 chkstride1(A)
4683 n = checksquare(A)
4684 chkuplo(uplo)
4685 ipiv = similar(A, BlasInt, n)
4686 work = Vector{$elty}(undef, 1)
4687 lwork = BlasInt(-1)
4688 info = Ref{BlasInt}()
4689 for i in 1:2 # first call returns lwork as work[1]
4690 ccall((@blasfunc($hetrf), libblastrampoline), Cvoid,
4691 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4692 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4693 uplo, n, A, max(1,stride(A,2)), ipiv, work, lwork, info, 1)
4694 chkargsok(info[])
4695 if i == 1
4696 lwork = BlasInt(real(work[1]))
4697 resize!(work, lwork)
4698 end
4699 end
4700 A, ipiv, info[]
4701 end
4702
4703 # SUBROUTINE ZHETRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO )
4704 # * .. Scalar Arguments ..
4705 # CHARACTER UPLO
4706 # INTEGER INFO, LDA, N
4707 # * ..
4708 # * .. Array Arguments ..
4709 # INTEGER IPIV( * )
4710 # COMPLEX*16 A( LDA, * ), WORK( * )
4711 function hetri_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4712 chkstride1(A,ipiv)
4713 n = checksquare(A)
4714 chkuplo(uplo)
4715 work = Vector{$elty}(undef, n)
4716 info = Ref{BlasInt}()
4717 ccall((@blasfunc($hetri), libblastrampoline), Cvoid,
4718 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4719 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong),
4720 uplo, n, A, max(1,stride(A,2)), ipiv, work, info, 1)
4721 chklapackerror(info[])
4722 A
4723 end
4724
4725 # SUBROUTINE ZHETRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
4726 # * .. Scalar Arguments ..
4727 # CHARACTER UPLO
4728 # INTEGER INFO, LDA, LDB, N, NRHS
4729 # * ..
4730 # * .. Array Arguments ..
4731 # INTEGER IPIV( * )
4732 # COMPLEX*16 A( LDA, * ), B( LDB, * )
4733 function hetrs_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty},
4734 ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat{$elty})
4735 require_one_based_indexing(A, ipiv, B)
4736 chkstride1(A,B,ipiv)
4737 n = checksquare(A)
4738 if n != size(B,1)
4739 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4740 end
4741 info = Ref{BlasInt}()
4742 ccall((@blasfunc($hetrs), libblastrampoline), Cvoid,
4743 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4744 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4745 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info, 1)
4746 chklapackerror(info[])
4747 B
4748 end
4749 end
4750 end
4751
4752 for (sysv, sytrf, sytri, sytrs, elty, relty) in
4753 ((:zsysv_,:zsytrf_,:zsytri_,:zsytrs_,:ComplexF64, :Float64),
4754 (:csysv_,:csytrf_,:csytri_,:csytrs_,:ComplexF32, :Float32))
4755 @eval begin
4756 # SUBROUTINE ZSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
4757 # $ LWORK, INFO )
4758 # * .. Scalar Arguments ..
4759 # CHARACTER UPLO
4760 # INTEGER INFO, LDA, LDB, LWORK, N, NRHS
4761 # * ..
4762 # * .. Array Arguments ..
4763 # INTEGER IPIV( * )
4764 # COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
4765 function sysv!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
4766 require_one_based_indexing(A, B)
4767 chkstride1(A,B)
4768 n = checksquare(A)
4769 chkuplo(uplo)
4770 if n != size(B,1)
4771 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4772 end
4773 ipiv = similar(A, BlasInt, n)
4774 work = Vector{$elty}(undef, 1)
4775 lwork = BlasInt(-1)
4776 info = Ref{BlasInt}()
4777 for i = 1:2 # first call returns lwork as work[1]
4778 ccall((@blasfunc($sysv), libblastrampoline), Cvoid,
4779 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
4780 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4781 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)),
4782 work, lwork, info, 1)
4783 chkargsok(info[])
4784 chknonsingular(info[])
4785 if i == 1
4786 lwork = BlasInt(real(work[1]))
4787 resize!(work, lwork)
4788 end
4789 end
4790 B, A, ipiv
4791 end
4792
4793 # SUBROUTINE ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4794 # * .. Scalar Arguments ..
4795 # CHARACTER UPLO
4796 # INTEGER INFO, LDA, LWORK, N
4797 # * ..
4798 # * .. Array Arguments ..
4799 # INTEGER IPIV( * )
4800 # COMPLEX*16 A( LDA, * ), WORK( * )
4801 function sytrf!(uplo::AbstractChar, A::AbstractMatrix{$elty})
4802 chkstride1(A)
4803 n = checksquare(A)
4804 chkuplo(uplo)
4805 ipiv = similar(A, BlasInt, n)
4806 if n == 0
4807 return A, ipiv, zero(BlasInt)
4808 end
4809 work = Vector{$elty}(undef, 1)
4810 lwork = BlasInt(-1)
4811 info = Ref{BlasInt}()
4812 for i = 1:2 # first call returns lwork as work[1]
4813 ccall((@blasfunc($sytrf), libblastrampoline), Cvoid,
4814 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4815 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4816 uplo, n, A, max(1,stride(A,2)), ipiv, work, lwork, info, 1)
4817 chkargsok(info[])
4818 if i == 1
4819 lwork = BlasInt(real(work[1]))
4820 resize!(work, lwork)
4821 end
4822 end
4823 A, ipiv, info[]
4824 end
4825
4826 # SUBROUTINE ZSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4827 # * .. Scalar Arguments ..
4828 # CHARACTER UPLO
4829 # INTEGER INFO, LDA, LWORK, N
4830 # * ..
4831 # * .. Array Arguments ..
4832 # INTEGER IPIV( * )
4833 # COMPLEX*16 A( LDA, * ), WORK( * )
4834 # function sytri!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::Vector{BlasInt})
4835 # chkstride1(A)
4836 # n = checksquare(A)
4837 # chkuplo(uplo)
4838 # work = Vector{$elty}(undef, 1)
4839 # lwork = BlasInt(-1)
4840 # info = Ref{BlasInt}()
4841 # for i in 1:2
4842 # ccall((@blasfunc($sytri), libblastrampoline), Cvoid,
4843 # (Ptr{UInt8}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt},
4844 # Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt}, Clong),
4845 # &uplo, &n, A, &max(1,stride(A,2)), ipiv, work, &lwork, info, 1)
4846 # chklapackerror(info[])
4847 # if lwork < 0
4848 # lwork = BlasInt(real(work[1]))
4849 # work = Vector{$elty}(undef, lwork)
4850 # end
4851 # end
4852 # A
4853 # end
4854
4855 # SUBROUTINE ZSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
4856 # * .. Scalar Arguments ..
4857 # CHARACTER UPLO
4858 # INTEGER INFO, LDA, N
4859 # * ..
4860 # * .. Array Arguments ..
4861 # INTEGER IPIV( * )
4862 # COMPLEX*16 A( LDA, * ), WORK( * )
4863 function sytri!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4864 chkstride1(A, ipiv)
4865 n = checksquare(A)
4866 chkuplo(uplo)
4867 work = Vector{$elty}(undef, n)
4868 info = Ref{BlasInt}()
4869 ccall((@blasfunc($sytri), libblastrampoline), Cvoid,
4870 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4871 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong),
4872 uplo, n, A, max(1,stride(A,2)), ipiv, work, info, 1)
4873 chklapackerror(info[])
4874 A
4875 end
4876
4877 # SUBROUTINE ZSYTRS( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
4878 # * .. Scalar Arguments ..
4879 # CHARACTER UPLO
4880 # INTEGER INFO, LDA, LDB, N, NRHS
4881 # * ..
4882 # * .. Array Arguments ..
4883 # INTEGER IPIV( * )
4884 # COMPLEX*16 A( LDA, * ), B( LDB, * )
4885 function sytrs!(uplo::AbstractChar, A::AbstractMatrix{$elty},
4886 ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat{$elty})
4887 require_one_based_indexing(A, ipiv, B)
4888 chkstride1(A,B,ipiv)
4889 n = checksquare(A)
4890 chkuplo(uplo)
4891 if n != size(B,1)
4892 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4893 end
4894 info = Ref{BlasInt}()
4895 ccall((@blasfunc($sytrs), libblastrampoline), Cvoid,
4896 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4897 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4898 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info, 1)
4899 chklapackerror(info[])
4900 B
4901 end
4902 end
4903 end
4904
4905 for (sysv, sytrf, sytri, sytrs, syconvf, elty, relty) in
4906 ((:zsysv_rook_,:zsytrf_rook_,:zsytri_rook_,:zsytrs_rook_,:zsyconvf_rook_,:ComplexF64, :Float64),
4907 (:csysv_rook_,:csytrf_rook_,:csytri_rook_,:csytrs_rook_,:csyconvf_rook_,:ComplexF32, :Float32))
4908 @eval begin
4909 # SUBROUTINE ZSYSV_ROOK(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
4910 # $ LWORK, INFO )
4911 # * .. Scalar Arguments ..
4912 # CHARACTER UPLO
4913 # INTEGER INFO, LDA, LDB, LWORK, N, NRHS
4914 # * ..
4915 # * .. Array Arguments ..
4916 # INTEGER IPIV( * )
4917 # COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
4918 function sysv_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractVecOrMat{$elty})
4919 require_one_based_indexing(A, B)
4920 chkstride1(A,B)
4921 n = checksquare(A)
4922 chkuplo(uplo)
4923 if n != size(B,1)
4924 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
4925 end
4926 ipiv = similar(A, BlasInt, n)
4927 work = Vector{$elty}(undef, 1)
4928 lwork = BlasInt(-1)
4929 info = Ref{BlasInt}()
4930 for i = 1:2 # first call returns lwork as work[1]
4931 ccall((@blasfunc($sysv), libblastrampoline), Cvoid,
4932 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
4933 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4934 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)),
4935 work, lwork, info, 1)
4936 chkargsok(info[])
4937 chknonsingular(info[])
4938 if i == 1
4939 lwork = BlasInt(real(work[1]))
4940 resize!(work, lwork)
4941 end
4942 end
4943 B, A, ipiv
4944 end
4945
4946 # SUBROUTINE ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
4947 # * .. Scalar Arguments ..
4948 # CHARACTER UPLO
4949 # INTEGER INFO, LDA, LWORK, N
4950 # * ..
4951 # * .. Array Arguments ..
4952 # INTEGER IPIV( * )
4953 # COMPLEX*16 A( LDA, * ), WORK( * )
4954 function sytrf_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty})
4955 chkstride1(A)
4956 n = checksquare(A)
4957 chkuplo(uplo)
4958 ipiv = similar(A, BlasInt, n)
4959 if n == 0
4960 return A, ipiv, zero(BlasInt)
4961 end
4962 work = Vector{$elty}(undef, 1)
4963 lwork = BlasInt(-1)
4964 info = Ref{BlasInt}()
4965 for i = 1:2 # first call returns lwork as work[1]
4966 ccall((@blasfunc($sytrf), libblastrampoline), Cvoid,
4967 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4968 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
4969 uplo, n, A, max(1,stride(A,2)), ipiv, work, lwork, info, 1)
4970 chkargsok(info[])
4971 if i == 1
4972 lwork = BlasInt(real(work[1]))
4973 resize!(work, lwork)
4974 end
4975 end
4976 A, ipiv, info[]
4977 end
4978
4979 # SUBROUTINE ZSYTRI_ROOK( UPLO, N, A, LDA, IPIV, WORK, INFO )
4980 # * .. Scalar Arguments ..
4981 # CHARACTER UPLO
4982 # INTEGER INFO, LDA, N
4983 # * ..
4984 # * .. Array Arguments ..
4985 # INTEGER IPIV( * )
4986 # COMPLEX*16 A( LDA, * ), WORK( * )
4987 function sytri_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt})
4988 chkstride1(A, ipiv)
4989 n = checksquare(A)
4990 chkuplo(uplo)
4991 work = Vector{$elty}(undef, n)
4992 info = Ref{BlasInt}()
4993 ccall((@blasfunc($sytri), libblastrampoline), Cvoid,
4994 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
4995 Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Clong),
4996 uplo, n, A, max(1,stride(A,2)), ipiv, work, info, 1)
4997 chklapackerror(info[])
4998 A
4999 end
5000
5001 # SUBROUTINE ZSYTRS_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
5002 # * .. Scalar Arguments ..
5003 # CHARACTER UPLO
5004 # INTEGER INFO, LDA, LDB, N, NRHS
5005 # * ..
5006 # * .. Array Arguments ..
5007 # INTEGER IPIV( * )
5008 # COMPLEX*16 A( LDA, * ), B( LDB, * )
5009 function sytrs_rook!(uplo::AbstractChar, A::AbstractMatrix{$elty},
5010 ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat{$elty})
5011 require_one_based_indexing(A, ipiv, B)
5012 chkstride1(A,B,ipiv)
5013 n = checksquare(A)
5014 chkuplo(uplo)
5015 if n != size(B,1)
5016 throw(DimensionMismatch("B has first dimension $(size(B,1)), but needs $n"))
5017 end
5018 info = Ref{BlasInt}()
5019 ccall((@blasfunc($sytrs), libblastrampoline), Cvoid,
5020 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5021 Ptr{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
5022 uplo, n, size(B,2), A, max(1,stride(A,2)), ipiv, B, max(1,stride(B,2)), info, 1)
5023 chklapackerror(info[])
5024 B
5025 end
5026
5027 # SUBROUTINE ZSYCONVF_ROOK( UPLO, WAY, N, A, LDA, IPIV, E, INFO )
5028 #
5029 # .. Scalar Arguments ..
5030 # CHARACTER UPLO, WAY
5031 # INTEGER INFO, LDA, N
5032 # ..
5033 # .. Array Arguments ..
5034 # INTEGER IPIV( * )
5035 # COMPLEX*16 A( LDA, * ), E( * )
5036 function syconvf_rook!(uplo::AbstractChar, way::AbstractChar,
5037 A::AbstractMatrix{$elty}, ipiv::AbstractVector{BlasInt},
5038 e::AbstractVector{$elty} = Vector{$elty}(undef, length(ipiv)))
5039 require_one_based_indexing(A, ipiv, e)
5040 chkstride1(A, ipiv, e)
5041
5042 # extract
5043 n = checksquare(A)
5044 lda = stride(A, 2)
5045
5046 # check
5047 chkuplo(uplo)
5048 if way != 'C' && way != 'R'
5049 throw(ArgumentError("way must be 'C' or 'R'"))
5050 end
5051 if length(ipiv) != n
5052 throw(ArgumentError("length of pivot vector was $(length(ipiv)) but should have been $n"))
5053 end
5054 if length(e) != n
5055 throw(ArgumentError("length of e vector was $(length(e)) but should have been $n"))
5056 end
5057
5058 # allocate
5059 info = Ref{BlasInt}()
5060
5061 ccall((@blasfunc($syconvf), libblastrampoline), Cvoid,
5062 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
5063 Ref{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt},
5064 Clong, Clong),
5065 uplo, way, n, A,
5066 max(1, lda), e, ipiv, info,
5067 1, 1)
5068
5069 chklapackerror(info[])
5070 return A, e
5071 end
5072 end
5073 end
5074
5075 """
5076 syconv!(uplo, A, ipiv) -> (A, work)
5077
5078 Converts a symmetric matrix `A` (which has been factorized into a
5079 triangular matrix) into two matrices `L` and `D`. If `uplo = U`, `A`
5080 is upper triangular. If `uplo = L`, it is lower triangular. `ipiv` is
5081 the pivot vector from the triangular factorization. `A` is overwritten
5082 by `L` and `D`.
5083 """
5084 syconv!(uplo::AbstractChar, A::AbstractMatrix, ipiv::AbstractVector{BlasInt})
5085
5086 """
5087 sysv!(uplo, A, B) -> (B, A, ipiv)
5088
5089 Finds the solution to `A * X = B` for symmetric matrix `A`. If `uplo = U`,
5090 the upper half of `A` is stored. If `uplo = L`, the lower half is stored.
5091 `B` is overwritten by the solution `X`. `A` is overwritten by its
5092 Bunch-Kaufman factorization. `ipiv` contains pivoting information about the
5093 factorization.
5094 """
5095 sysv!(uplo::AbstractChar, A::AbstractMatrix, B::AbstractVecOrMat)
5096
5097 """
5098 sytrf!(uplo, A) -> (A, ipiv, info)
5099
5100 Computes the Bunch-Kaufman factorization of a symmetric matrix `A`. If
5101 `uplo = U`, the upper half of `A` is stored. If `uplo = L`, the lower
5102 half is stored.
5103
5104 Returns `A`, overwritten by the factorization, a pivot vector `ipiv`, and
5105 the error code `info` which is a non-negative integer. If `info` is positive
5106 the matrix is singular and the diagonal part of the factorization is exactly
5107 zero at position `info`.
5108 """
5109 sytrf!(uplo::AbstractChar, A::AbstractMatrix)
5110
5111 """
5112 sytri!(uplo, A, ipiv)
5113
5114 Computes the inverse of a symmetric matrix `A` using the results of
5115 `sytrf!`. If `uplo = U`, the upper half of `A` is stored. If `uplo = L`,
5116 the lower half is stored. `A` is overwritten by its inverse.
5117 """
5118 sytri!(uplo::AbstractChar, A::AbstractMatrix, ipiv::AbstractVector{BlasInt})
5119
5120 """
5121 sytrs!(uplo, A, ipiv, B)
5122
5123 Solves the equation `A * X = B` for a symmetric matrix `A` using the
5124 results of `sytrf!`. If `uplo = U`, the upper half of `A` is stored.
5125 If `uplo = L`, the lower half is stored. `B` is overwritten by the
5126 solution `X`.
5127 """
5128 sytrs!(uplo::AbstractChar, A::AbstractMatrix, ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat)
5129
5130
5131 """
5132 hesv!(uplo, A, B) -> (B, A, ipiv)
5133
5134 Finds the solution to `A * X = B` for Hermitian matrix `A`. If `uplo = U`,
5135 the upper half of `A` is stored. If `uplo = L`, the lower half is stored.
5136 `B` is overwritten by the solution `X`. `A` is overwritten by its
5137 Bunch-Kaufman factorization. `ipiv` contains pivoting information about the
5138 factorization.
5139 """
5140 hesv!(uplo::AbstractChar, A::AbstractMatrix, B::AbstractVecOrMat)
5141
5142 """
5143 hetrf!(uplo, A) -> (A, ipiv, info)
5144
5145 Computes the Bunch-Kaufman factorization of a Hermitian matrix `A`. If
5146 `uplo = U`, the upper half of `A` is stored. If `uplo = L`, the lower
5147 half is stored.
5148
5149 Returns `A`, overwritten by the factorization, a pivot vector `ipiv`, and
5150 the error code `info` which is a non-negative integer. If `info` is positive
5151 the matrix is singular and the diagonal part of the factorization is exactly
5152 zero at position `info`.
5153 """
5154 hetrf!(uplo::AbstractChar, A::AbstractMatrix)
5155
5156 """
5157 hetri!(uplo, A, ipiv)
5158
5159 Computes the inverse of a Hermitian matrix `A` using the results of
5160 `sytrf!`. If `uplo = U`, the upper half of `A` is stored. If `uplo = L`,
5161 the lower half is stored. `A` is overwritten by its inverse.
5162 """
5163 hetri!(uplo::AbstractChar, A::AbstractMatrix, ipiv::AbstractVector{BlasInt})
5164
5165 """
5166 hetrs!(uplo, A, ipiv, B)
5167
5168 Solves the equation `A * X = B` for a Hermitian matrix `A` using the
5169 results of `sytrf!`. If `uplo = U`, the upper half of `A` is stored.
5170 If `uplo = L`, the lower half is stored. `B` is overwritten by the
5171 solution `X`.
5172 """
5173 hetrs!(uplo::AbstractChar, A::AbstractMatrix, ipiv::AbstractVector{BlasInt}, B::AbstractVecOrMat)
5174
5175 # Symmetric (real) eigensolvers
5176 for (syev, syevr, syevd, sygvd, elty) in
5177 ((:dsyev_,:dsyevr_,:dsyevd_,:dsygvd_,:Float64),
5178 (:ssyev_,:ssyevr_,:ssyevd_,:ssygvd_,:Float32))
5179 @eval begin
5180 # SUBROUTINE DSYEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, INFO )
5181 # * .. Scalar Arguments ..
5182 # CHARACTER JOBZ, UPLO
5183 # INTEGER INFO, LDA, LWORK, N
5184 # * .. Array Arguments ..
5185 # DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
5186 function syev!(jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty})
5187 chkstride1(A)
5188 n = checksquare(A)
5189 W = similar(A, $elty, n)
5190 work = Vector{$elty}(undef, 1)
5191 lwork = BlasInt(-1)
5192 info = Ref{BlasInt}()
5193 for i = 1:2 # first call returns lwork as work[1]
5194 ccall((@blasfunc($syev), libblastrampoline), Cvoid,
5195 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5196 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
5197 jobz, uplo, n, A, max(1,stride(A,2)), W, work, lwork, info, 1, 1)
5198 chklapackerror(info[])
5199 if i == 1
5200 lwork = BlasInt(real(work[1]))
5201 resize!(work, lwork)
5202 end
5203 end
5204 jobz == 'V' ? (W, A) : W
5205 end
5206
5207 # SUBROUTINE DSYEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
5208 # $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
5209 # $ IWORK, LIWORK, INFO )
5210 # * .. Scalar Arguments ..
5211 # CHARACTER JOBZ, RANGE, UPLO
5212 # INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
5213 # DOUBLE PRECISION ABSTOL, VL, VU
5214 # * ..
5215 # * .. Array Arguments ..
5216 # INTEGER ISUPPZ( * ), IWORK( * )
5217 # DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
5218 function syevr!(jobz::AbstractChar, range::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty},
5219 vl::AbstractFloat, vu::AbstractFloat, il::Integer, iu::Integer, abstol::AbstractFloat)
5220 chkstride1(A)
5221 n = checksquare(A)
5222 chkuplofinite(A, uplo)
5223 if range == 'I' && !(1 <= il <= iu <= n)
5224 throw(ArgumentError("illegal choice of eigenvalue indices (il = $il, iu = $iu), which must be between 1 and n = $n"))
5225 end
5226 if range == 'V' && vl >= vu
5227 throw(ArgumentError("lower boundary, $vl, must be less than upper boundary, $vu"))
5228 end
5229 lda = stride(A,2)
5230 m = Ref{BlasInt}()
5231 W = similar(A, $elty, n)
5232 ldz = n
5233 if jobz == 'N'
5234 Z = similar(A, $elty, ldz, 0)
5235 elseif jobz == 'V'
5236 Z = similar(A, $elty, ldz, n)
5237 end
5238 isuppz = similar(A, BlasInt, 2*n)
5239 work = Vector{$elty}(undef, 1)
5240 lwork = BlasInt(-1)
5241 iwork = Vector{BlasInt}(undef, 1)
5242 liwork = BlasInt(-1)
5243 info = Ref{BlasInt}()
5244 for i = 1:2 # first call returns lwork as work[1] and liwork as iwork[1]
5245 ccall((@blasfunc($syevr), libblastrampoline), Cvoid,
5246 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
5247 Ptr{$elty}, Ref{BlasInt}, Ref{$elty}, Ref{$elty},
5248 Ref{BlasInt}, Ref{BlasInt}, Ref{$elty}, Ptr{BlasInt},
5249 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
5250 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
5251 Ptr{BlasInt}, Clong, Clong, Clong),
5252 jobz, range, uplo, n,
5253 A, max(1,lda), vl, vu,
5254 il, iu, abstol, m,
5255 W, Z, max(1,ldz), isuppz,
5256 work, lwork, iwork, liwork,
5257 info, 1, 1, 1)
5258 chklapackerror(info[])
5259 if i == 1
5260 lwork = BlasInt(real(work[1]))
5261 resize!(work, lwork)
5262 liwork = iwork[1]
5263 resize!(iwork, liwork)
5264 end
5265 end
5266 W[1:m[]], Z[:,1:(jobz == 'V' ? m[] : 0)]
5267 end
5268 syevr!(jobz::AbstractChar, A::AbstractMatrix{$elty}) =
5269 syevr!(jobz, 'A', 'U', A, 0.0, 0.0, 0, 0, -1.0)
5270
5271 # SUBROUTINE DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
5272 # $ IWORK, LIWORK, INFO )
5273 # * .. Scalar Arguments ..
5274 # CHARACTER JOBZ, UPLO
5275 # INTEGER INFO, LDA, LIWORK, LWORK, N
5276 # * ..
5277 # * .. Array Arguments ..
5278 # INTEGER IWORK( * )
5279 # DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * )
5280 function syevd!(jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty})
5281 chkstride1(A)
5282 n = checksquare(A)
5283 chkuplofinite(A, uplo)
5284 lda = stride(A,2)
5285 m = Ref{BlasInt}()
5286 W = similar(A, $elty, n)
5287 work = Vector{$elty}(undef, 1)
5288 lwork = BlasInt(-1)
5289 iwork = Vector{BlasInt}(undef, 1)
5290 liwork = BlasInt(-1)
5291 info = Ref{BlasInt}()
5292 for i = 1:2 # first call returns lwork as work[1] and liwork as iwork[1]
5293 ccall((@blasfunc($syevd), libblastrampoline), Cvoid,
5294 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5295 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
5296 Ptr{BlasInt}, Clong, Clong),
5297 jobz, uplo, n, A, max(1,lda),
5298 W, work, lwork, iwork, liwork,
5299 info, 1, 1)
5300 chklapackerror(info[])
5301 if i == 1
5302 lwork = BlasInt(real(work[1]))
5303 resize!(work, lwork)
5304 liwork = iwork[1]
5305 resize!(iwork, liwork)
5306 end
5307 end
5308 jobz == 'V' ? (W, A) : W
5309 end
5310
5311 # Generalized eigenproblem
5312 # SUBROUTINE DSYGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
5313 # $ LWORK, IWORK, LIWORK, INFO )
5314 # * .. Scalar Arguments ..
5315 # CHARACTER JOBZ, UPLO
5316 # INTEGER INFO, ITYPE, LDA, LDB, LIWORK, LWORK, N
5317 # * ..
5318 # * .. Array Arguments ..
5319 # INTEGER IWORK( * )
5320 # DOUBLE PRECISION A( LDA, * ), B( LDB, * ), W( * ), WORK( * )
5321 function sygvd!(itype::Integer, jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
5322 chkstride1(A, B)
5323 n, m = checksquare(A, B)
5324 if n != m
5325 throw(DimensionMismatch("dimensions of A, ($n,$n), and B, ($m,$m), must match"))
5326 end
5327 lda = max(1, stride(A, 2))
5328 ldb = max(1, stride(B, 2))
5329 w = similar(A, $elty, n)
5330 work = Vector{$elty}(undef, 1)
5331 lwork = BlasInt(-1)
5332 iwork = Vector{BlasInt}(undef, 1)
5333 liwork = BlasInt(-1)
5334 info = Ref{BlasInt}()
5335 for i = 1:2 # first call returns lwork as work[1] and liwork as iwork[1]
5336 ccall((@blasfunc($sygvd), libblastrampoline), Cvoid,
5337 (Ref{BlasInt}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
5338 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5339 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
5340 Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
5341 itype, jobz, uplo, n,
5342 A, lda, B, ldb,
5343 w, work, lwork, iwork,
5344 liwork, info, 1, 1)
5345 chkargsok(info[])
5346 if i == 1
5347 lwork = BlasInt(work[1])
5348 resize!(work, lwork)
5349 liwork = iwork[1]
5350 resize!(iwork, liwork)
5351 end
5352 end
5353 chkposdef(info[])
5354 w, A, B
5355 end
5356 end
5357 end
5358 # Hermitian eigensolvers
5359 for (syev, syevr, syevd, sygvd, elty, relty) in
5360 ((:zheev_,:zheevr_,:zheevd_,:zhegvd_,:ComplexF64,:Float64),
5361 (:cheev_,:cheevr_,:cheevd_,:chegvd_,:ComplexF32,:Float32))
5362 @eval begin
5363 # SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, INFO )
5364 # * .. Scalar Arguments ..
5365 # CHARACTER JOBZ, UPLO
5366 # INTEGER INFO, LDA, LWORK, N
5367 # * ..
5368 # * .. Array Arguments ..
5369 # DOUBLE PRECISION RWORK( * ), W( * )
5370 # COMPLEX*16 A( LDA, * ), WORK( * )
5371 function syev!(jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty})
5372 chkstride1(A)
5373 chkuplofinite(A, uplo)
5374 n = checksquare(A)
5375 W = similar(A, $relty, n)
5376 work = Vector{$elty}(undef, 1)
5377 lwork = BlasInt(-1)
5378 rwork = Vector{$relty}(undef, max(1, 3n-2))
5379 info = Ref{BlasInt}()
5380 for i = 1:2 # first call returns lwork as work[1]
5381 ccall((@blasfunc($syev), libblastrampoline), Cvoid,
5382 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5383 Ptr{$relty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ptr{BlasInt},
5384 Clong, Clong),
5385 jobz, uplo, n, A, stride(A,2), W, work, lwork, rwork, info,
5386 1, 1)
5387 chklapackerror(info[])
5388 if i == 1
5389 lwork = BlasInt(real(work[1]))
5390 resize!(work, lwork)
5391 end
5392 end
5393 jobz == 'V' ? (W, A) : W
5394 end
5395
5396 # SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
5397 # $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
5398 # $ RWORK, LRWORK, IWORK, LIWORK, INFO )
5399 # * .. Scalar Arguments ..
5400 # CHARACTER JOBZ, RANGE, UPLO
5401 # INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LRWORK, LWORK,
5402 # $ M, N
5403 # DOUBLE PRECISION ABSTOL, VL, VU
5404 # * ..
5405 # * .. Array Arguments ..
5406 # INTEGER ISUPPZ( * ), IWORK( * )
5407 # DOUBLE PRECISION RWORK( * ), W( * )
5408 # COMPLEX*16 A( LDA, * ), WORK( * ), Z( LDZ, * )
5409 function syevr!(jobz::AbstractChar, range::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty},
5410 vl::AbstractFloat, vu::AbstractFloat, il::Integer, iu::Integer, abstol::AbstractFloat)
5411 chkstride1(A)
5412 chkuplofinite(A, uplo)
5413 n = checksquare(A)
5414 if range == 'I' && !(1 <= il <= iu <= n)
5415 throw(ArgumentError("illegal choice of eigenvalue indices (il = $il, iu=$iu), which must be between 1 and n = $n"))
5416 end
5417 if range == 'V' && vl >= vu
5418 throw(ArgumentError("lower boundary, $vl, must be less than upper boundary, $vu"))
5419 end
5420 lda = max(1,stride(A,2))
5421 m = Ref{BlasInt}()
5422 W = similar(A, $relty, n)
5423 if jobz == 'N'
5424 ldz = 1
5425 Z = similar(A, $elty, ldz, 0)
5426 elseif jobz == 'V'
5427 ldz = n
5428 Z = similar(A, $elty, ldz, n)
5429 end
5430 isuppz = similar(A, BlasInt, 2*n)
5431 work = Vector{$elty}(undef, 1)
5432 lwork = BlasInt(-1)
5433 rwork = Vector{$relty}(undef, 1)
5434 lrwork = BlasInt(-1)
5435 iwork = Vector{BlasInt}(undef, 1)
5436 liwork = BlasInt(-1)
5437 info = Ref{BlasInt}()
5438 for i = 1:2 # first call returns lwork as work[1], lrwork as rwork[1] and liwork as iwork[1]
5439 ccall((@blasfunc($syevr), libblastrampoline), Cvoid,
5440 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
5441 Ptr{$elty}, Ref{BlasInt}, Ref{$elty}, Ref{$elty},
5442 Ref{BlasInt}, Ref{BlasInt}, Ref{$elty}, Ptr{BlasInt},
5443 Ptr{$relty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt},
5444 Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ref{BlasInt},
5445 Ptr{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
5446 Clong, Clong, Clong),
5447 jobz, range, uplo, n,
5448 A, lda, vl, vu,
5449 il, iu, abstol, m,
5450 W, Z, ldz, isuppz,
5451 work, lwork, rwork, lrwork,
5452 iwork, liwork, info,
5453 1, 1, 1)
5454 chklapackerror(info[])
5455 if i == 1
5456 lwork = BlasInt(real(work[1]))
5457 resize!(work, lwork)
5458 lrwork = BlasInt(rwork[1])
5459 resize!(rwork, lrwork)
5460 liwork = iwork[1]
5461 resize!(iwork, liwork)
5462 end
5463 end
5464 W[1:m[]], Z[:,1:(jobz == 'V' ? m[] : 0)]
5465 end
5466 syevr!(jobz::AbstractChar, A::AbstractMatrix{$elty}) =
5467 syevr!(jobz, 'A', 'U', A, 0.0, 0.0, 0, 0, -1.0)
5468
5469 # SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
5470 # $ LRWORK, IWORK, LIWORK, INFO )
5471 # * .. Scalar Arguments ..
5472 # CHARACTER JOBZ, UPLO
5473 # INTEGER INFO, LDA, LIWORK, LRWORK, LWORK, N
5474 # * ..
5475 # * .. Array Arguments ..
5476 # INTEGER IWORK( * )
5477 # DOUBLE PRECISION RWORK( * )
5478 # COMPLEX*16 A( LDA, * ), WORK( * )
5479 function syevd!(jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty})
5480 chkstride1(A)
5481 chkuplofinite(A, uplo)
5482 n = checksquare(A)
5483 lda = max(1, stride(A,2))
5484 m = Ref{BlasInt}()
5485 W = similar(A, $relty, n)
5486 work = Vector{$elty}(undef, 1)
5487 lwork = BlasInt(-1)
5488 rwork = Vector{$relty}(undef, 1)
5489 lrwork = BlasInt(-1)
5490 iwork = Vector{BlasInt}(undef, 1)
5491 liwork = BlasInt(-1)
5492 info = Ref{BlasInt}()
5493 for i = 1:2 # first call returns lwork as work[1], lrwork as rwork[1] and liwork as iwork[1]
5494 ccall((@blasfunc($syevd), liblapack), Cvoid,
5495 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5496 Ptr{$relty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ref{BlasInt},
5497 Ptr{BlasInt}, Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
5498 jobz, uplo, n, A, stride(A,2),
5499 W, work, lwork, rwork, lrwork,
5500 iwork, liwork, info, 1, 1)
5501 chklapackerror(info[])
5502 if i == 1
5503 lwork = BlasInt(real(work[1]))
5504 resize!(work, lwork)
5505 lrwork = BlasInt(rwork[1])
5506 resize!(rwork, lrwork)
5507 liwork = iwork[1]
5508 resize!(iwork, liwork)
5509 end
5510 end
5511 jobz == 'V' ? (W, A) : W
5512 end
5513
5514 # SUBROUTINE ZHEGVD( ITYPE, JOBZ, UPLO, N, A, LDA, B, LDB, W, WORK,
5515 # $ LWORK, RWORK, LRWORK, IWORK, LIWORK, INFO )
5516 # * .. Scalar Arguments ..
5517 # CHARACTER JOBZ, UPLO
5518 # INTEGER INFO, ITYPE, LDA, LDB, LIWORK, LRWORK, LWORK, N
5519 # * ..
5520 # * .. Array Arguments ..
5521 # INTEGER IWORK( * )
5522 # DOUBLE PRECISION RWORK( * ), W( * )
5523 # COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
5524 function sygvd!(itype::Integer, jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
5525 chkstride1(A, B)
5526 chkuplofinite(A, uplo)
5527 chkuplofinite(B, uplo)
5528 n, m = checksquare(A, B)
5529 if n != m
5530 throw(DimensionMismatch("dimensions of A, ($n,$n), and B, ($m,$m), must match"))
5531 end
5532 lda = max(1, stride(A, 2))
5533 ldb = max(1, stride(B, 2))
5534 w = similar(A, $relty, n)
5535 work = Vector{$elty}(undef, 1)
5536 lwork = BlasInt(-1)
5537 iwork = Vector{BlasInt}(undef, 1)
5538 liwork = BlasInt(-1)
5539 rwork = Vector{$relty}(undef, 1)
5540 lrwork = BlasInt(-1)
5541 info = Ref{BlasInt}()
5542 for i = 1:2 # first call returns lwork as work[1], lrwork as rwork[1] and liwork as iwork[1]
5543 ccall((@blasfunc($sygvd), libblastrampoline), Cvoid,
5544 (Ref{BlasInt}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt},
5545 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5546 Ptr{$relty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$relty},
5547 Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
5548 Clong, Clong),
5549 itype, jobz, uplo, n,
5550 A, lda, B, ldb,
5551 w, work, lwork, rwork,
5552 lrwork, iwork, liwork, info,
5553 1, 1)
5554 chkargsok(info[])
5555 if i == 1
5556 lwork = BlasInt(real(work[1]))
5557 resize!(work, lwork)
5558 liwork = iwork[1]
5559 resize!(iwork, liwork)
5560 lrwork = BlasInt(rwork[1])
5561 resize!(rwork, lrwork)
5562 end
5563 end
5564 chkposdef(info[])
5565 w, A, B
5566 end
5567 end
5568 end
5569
5570 """
5571 syev!(jobz, uplo, A)
5572
5573 Finds the eigenvalues (`jobz = N`) or eigenvalues and eigenvectors
5574 (`jobz = V`) of a symmetric matrix `A`. If `uplo = U`, the upper triangle
5575 of `A` is used. If `uplo = L`, the lower triangle of `A` is used.
5576 """
5577 syev!(jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix)
5578
5579 """
5580 syevr!(jobz, range, uplo, A, vl, vu, il, iu, abstol) -> (W, Z)
5581
5582 Finds the eigenvalues (`jobz = N`) or eigenvalues and eigenvectors
5583 (`jobz = V`) of a symmetric matrix `A`. If `uplo = U`, the upper triangle
5584 of `A` is used. If `uplo = L`, the lower triangle of `A` is used. If
5585 `range = A`, all the eigenvalues are found. If `range = V`, the
5586 eigenvalues in the half-open interval `(vl, vu]` are found.
5587 If `range = I`, the eigenvalues with indices between `il` and `iu` are
5588 found. `abstol` can be set as a tolerance for convergence.
5589
5590 The eigenvalues are returned in `W` and the eigenvectors in `Z`.
5591 """
5592 syevr!(jobz::AbstractChar, range::AbstractChar, uplo::AbstractChar, A::AbstractMatrix,
5593 vl::AbstractFloat, vu::AbstractFloat, il::Integer, iu::Integer, abstol::AbstractFloat)
5594
5595 """
5596 syevd!(jobz, uplo, A)
5597
5598 Finds the eigenvalues (`jobz = N`) or eigenvalues and eigenvectors
5599 (`jobz = V`) of a symmetric matrix `A`. If `uplo = U`, the upper triangle
5600 of `A` is used. If `uplo = L`, the lower triangle of `A` is used.
5601
5602 Use the divide-and-conquer method, instead of the QR iteration used by
5603 `syev!` or multiple relatively robust representations used by `syevr!`.
5604 See James W. Demmel et al, SIAM J. Sci. Comput. 30, 3, 1508 (2008) for
5605 a comparison of the accuracy and performatce of different methods.
5606 """
5607 syevd!(jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix)
5608
5609 """
5610 sygvd!(itype, jobz, uplo, A, B) -> (w, A, B)
5611
5612 Finds the generalized eigenvalues (`jobz = N`) or eigenvalues and
5613 eigenvectors (`jobz = V`) of a symmetric matrix `A` and symmetric
5614 positive-definite matrix `B`. If `uplo = U`, the upper triangles
5615 of `A` and `B` are used. If `uplo = L`, the lower triangles of `A` and
5616 `B` are used. If `itype = 1`, the problem to solve is
5617 `A * x = lambda * B * x`. If `itype = 2`, the problem to solve is
5618 `A * B * x = lambda * x`. If `itype = 3`, the problem to solve is
5619 `B * A * x = lambda * x`.
5620 """
5621 sygvd!(itype::Integer, jobz::AbstractChar, uplo::AbstractChar, A::AbstractMatrix, B::AbstractMatrix)
5622
5623 ## (BD) Bidiagonal matrices - singular value decomposition
5624 for (bdsqr, relty, elty) in
5625 ((:dbdsqr_,:Float64,:Float64),
5626 (:sbdsqr_,:Float32,:Float32),
5627 (:zbdsqr_,:Float64,:ComplexF64),
5628 (:cbdsqr_,:Float32,:ComplexF32))
5629 @eval begin
5630 function bdsqr!(uplo::AbstractChar, d::AbstractVector{$relty}, e_::AbstractVector{$relty},
5631 Vt::AbstractMatrix{$elty}, U::AbstractMatrix{$elty}, C::AbstractMatrix{$elty})
5632 require_one_based_indexing(d, e_, Vt, U, C)
5633 chkstride1(d, e_, Vt, U, C)
5634 # Extract number
5635 n = length(d)
5636 ncvt, nru, ncc = size(Vt, 2), size(U, 1), size(C, 2)
5637 ldvt, ldu, ldc = max(1, stride(Vt,2)), max(1, stride(U, 2)), max(1, stride(C,2))
5638 # Do checks
5639 chkuplo(uplo)
5640 if length(e_) != n - 1
5641 throw(DimensionMismatch("off-diagonal has length $(length(e_)) but should have length $(n - 1)"))
5642 end
5643 if ncvt > 0 && ldvt < n
5644 throw(DimensionMismatch("leading dimension of Vt, $ldvt, must be at least $n"))
5645 end
5646 if ldu < nru
5647 throw(DimensionMismatch("leading dimension of U, $ldu, must be at least $nru"))
5648 end
5649 if size(U, 2) != n
5650 throw(DimensionMismatch("U must have $n columns but has $(size(U, 2))"))
5651 end
5652 if ncc > 0 && ldc < n
5653 throw(DimensionMismatch("leading dimension of C, $ldc, must be at least $n"))
5654 end
5655 # Allocate
5656 work = Vector{$relty}(undef, 4n)
5657 info = Ref{BlasInt}()
5658 ccall((@blasfunc($bdsqr), libblastrampoline), Cvoid,
5659 (Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
5660 Ref{BlasInt}, Ptr{$relty}, Ptr{$relty}, Ptr{$elty},
5661 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
5662 Ref{BlasInt}, Ptr{$relty}, Ptr{BlasInt}, Clong),
5663 uplo, n, ncvt, nru,
5664 ncc, d, e_, Vt,
5665 ldvt, U, ldu, C,
5666 ldc, work, info, 1)
5667 chklapackerror(info[])
5668 d, Vt, U, C #singular values in descending order, P**T * VT, U * Q, Q**T * C
5669 end
5670 end
5671 end
5672
5673 """
5674 bdsqr!(uplo, d, e_, Vt, U, C) -> (d, Vt, U, C)
5675
5676 Computes the singular value decomposition of a bidiagonal matrix with
5677 `d` on the diagonal and `e_` on the off-diagonal. If `uplo = U`, `e_` is
5678 the superdiagonal. If `uplo = L`, `e_` is the subdiagonal. Can optionally also
5679 compute the product `Q' * C`.
5680
5681 Returns the singular values in `d`, and the matrix `C` overwritten with `Q' * C`.
5682 """
5683 bdsqr!(uplo::AbstractChar, d::AbstractVector, e_::AbstractVector, Vt::AbstractMatrix, U::AbstractMatrix, C::AbstractMatrix)
5684
5685 #Defined only for real types
5686 for (bdsdc, elty) in
5687 ((:dbdsdc_,:Float64),
5688 (:sbdsdc_,:Float32))
5689 @eval begin
5690 #* DBDSDC computes the singular value decomposition (SVD) of a real
5691 #* N-by-N (upper or lower) bidiagonal matrix B: B = U * S * VT,
5692 #* using a divide and conquer method
5693 #* .. Scalar Arguments ..
5694 # CHARACTER COMPQ, UPLO
5695 # INTEGER INFO, LDU, LDVT, N
5696 #* ..
5697 #* .. Array Arguments ..
5698 # INTEGER IQ( * ), IWORK( * )
5699 # DOUBLE PRECISION D( * ), E( * ), Q( * ), U( LDU, * ),
5700 # $ VT( LDVT, * ), WORK( * )
5701 function bdsdc!(uplo::AbstractChar, compq::AbstractChar, d::AbstractVector{$elty}, e_::AbstractVector{$elty})
5702 require_one_based_indexing(d, e_)
5703 chkstride1(d, e_)
5704 n, ldiq, ldq, ldu, ldvt = length(d), 1, 1, 1, 1
5705 chkuplo(uplo)
5706 if compq == 'N'
5707 lwork = 6*n
5708 elseif compq == 'P'
5709 @warn "COMPQ='P' is not tested"
5710 #TODO turn this into an actual LAPACK call
5711 #smlsiz=ilaenv(9, $elty === :Float64 ? 'dbdsqr' : 'sbdsqr', string(uplo, compq), n,n,n,n)
5712 smlsiz=100 #For now, completely overkill
5713 ldq = n*(11+2*smlsiz+8*round(Int,log((n/(smlsiz+1)))/log(2)))
5714 ldiq = n*(3+3*round(Int,log(n/(smlsiz+1))/log(2)))
5715 lwork = 6*n
5716 elseif compq == 'I'
5717 ldvt=ldu=max(1, n)
5718 lwork=3*n^2 + 4*n
5719 else
5720 throw(ArgumentError("COMPQ argument must be 'N', 'P' or 'I', got $(repr(compq))"))
5721 end
5722 u = similar(d, $elty, (ldu, n))
5723 vt = similar(d, $elty, (ldvt, n))
5724 q = similar(d, $elty, ldq)
5725 iq = similar(d, BlasInt, ldiq)
5726 work = Vector{$elty}(undef, lwork)
5727 iwork = Vector{BlasInt}(undef, 8n)
5728 info = Ref{BlasInt}()
5729 ccall((@blasfunc($bdsdc), libblastrampoline), Cvoid,
5730 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
5731 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5732 Ptr{$elty}, Ptr{BlasInt}, Ptr{$elty}, Ptr{BlasInt}, Ptr{BlasInt},
5733 Clong, Clong),
5734 uplo, compq, n, d, e_,
5735 u, ldu, vt, ldvt,
5736 q, iq, work, iwork, info,
5737 1, 1)
5738 chklapackerror(info[])
5739 d, e_, u, vt, q, iq
5740 end
5741 end
5742 end
5743
5744 """
5745 bdsdc!(uplo, compq, d, e_) -> (d, e, u, vt, q, iq)
5746
5747 Computes the singular value decomposition of a bidiagonal matrix with `d` on the
5748 diagonal and `e_` on the off-diagonal using a divide and conqueq method.
5749 If `uplo = U`, `e_` is the superdiagonal. If `uplo = L`, `e_` is the subdiagonal.
5750 If `compq = N`, only the singular values are found. If `compq = I`, the singular
5751 values and vectors are found. If `compq = P`, the singular values
5752 and vectors are found in compact form. Only works for real types.
5753
5754 Returns the singular values in `d`, and if `compq = P`, the compact singular
5755 vectors in `iq`.
5756 """
5757 bdsdc!(uplo::AbstractChar, compq::AbstractChar, d::AbstractVector, e_::AbstractVector)
5758
5759 for (gecon, elty) in
5760 ((:dgecon_,:Float64),
5761 (:sgecon_,:Float32))
5762 @eval begin
5763 # SUBROUTINE DGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK,
5764 # $ INFO )
5765 # * .. Scalar Arguments ..
5766 # CHARACTER NORM
5767 # INTEGER INFO, LDA, N
5768 # DOUBLE PRECISION ANORM, RCOND
5769 # * ..
5770 # * .. Array Arguments ..
5771 # INTEGER IWORK( * )
5772 # DOUBLE PRECISION A( LDA, * ), WORK( * )
5773 function gecon!(normtype::AbstractChar, A::AbstractMatrix{$elty}, anorm::$elty)
5774 chkstride1(A)
5775 n = checksquare(A)
5776 lda = max(1, stride(A, 2))
5777 rcond = Ref{$elty}()
5778 work = Vector{$elty}(undef, 4n)
5779 iwork = Vector{BlasInt}(undef, n)
5780 info = Ref{BlasInt}()
5781 ccall((@blasfunc($gecon), libblastrampoline), Cvoid,
5782 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5783 Ref{$elty}, Ref{$elty}, Ptr{$elty}, Ptr{BlasInt},
5784 Ptr{BlasInt}, Clong),
5785 normtype, n, A, lda, anorm, rcond, work, iwork,
5786 info, 1)
5787 chklapackerror(info[])
5788 rcond[]
5789 end
5790 end
5791 end
5792
5793 for (gecon, elty, relty) in
5794 ((:zgecon_,:ComplexF64,:Float64),
5795 (:cgecon_,:ComplexF32,:Float32))
5796 @eval begin
5797 # SUBROUTINE ZGECON( NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK,
5798 # $ INFO )
5799 # * .. Scalar Arguments ..
5800 # CHARACTER NORM
5801 # INTEGER INFO, LDA, N
5802 # DOUBLE PRECISION ANORM, RCOND
5803 # * ..
5804 # * .. Array Arguments ..
5805 # DOUBLE PRECISION RWORK( * )
5806 # COMPLEX*16 A( LDA, * ), WORK( * )
5807 function gecon!(normtype::AbstractChar, A::AbstractMatrix{$elty}, anorm::$relty)
5808 chkstride1(A)
5809 n = checksquare(A)
5810 lda = max(1, stride(A, 2))
5811 rcond = Ref{$relty}()
5812 work = Vector{$elty}(undef, 2n)
5813 rwork = Vector{$relty}(undef, 2n)
5814 info = Ref{BlasInt}()
5815 ccall((@blasfunc($gecon), libblastrampoline), Cvoid,
5816 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5817 Ref{$relty}, Ref{$relty}, Ptr{$elty}, Ptr{$relty},
5818 Ptr{BlasInt}, Clong),
5819 normtype, n, A, lda, anorm, rcond, work, rwork,
5820 info, 1)
5821 chklapackerror(info[])
5822 rcond[]
5823 end
5824 end
5825 end
5826
5827 """
5828 gecon!(normtype, A, anorm)
5829
5830 Finds the reciprocal condition number of matrix `A`. If `normtype = I`,
5831 the condition number is found in the infinity norm. If `normtype = O` or
5832 `1`, the condition number is found in the one norm. `A` must be the
5833 result of `getrf!` and `anorm` is the norm of `A` in the relevant norm.
5834 """
5835 gecon!(normtype::AbstractChar, A::AbstractMatrix, anorm)
5836
5837 for (gehrd, elty) in
5838 ((:dgehrd_,:Float64),
5839 (:sgehrd_,:Float32),
5840 (:zgehrd_,:ComplexF64),
5841 (:cgehrd_,:ComplexF32))
5842 @eval begin
5843
5844 # .. Scalar Arguments ..
5845 # INTEGER IHI, ILO, INFO, LDA, LWORK, N
5846 # * ..
5847 # * .. Array Arguments ..
5848 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
5849 function gehrd!(ilo::Integer, ihi::Integer, A::AbstractMatrix{$elty})
5850 chkstride1(A)
5851 n = checksquare(A)
5852 chkfinite(A) # balancing routines don't support NaNs and Infs
5853 tau = similar(A, $elty, max(0,n - 1))
5854 work = Vector{$elty}(undef, 1)
5855 lwork = BlasInt(-1)
5856 info = Ref{BlasInt}()
5857 for i = 1:2 # first call returns lwork as work[1]
5858 ccall((@blasfunc($gehrd), libblastrampoline), Cvoid,
5859 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
5860 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
5861 Ptr{BlasInt}),
5862 n, ilo, ihi, A,
5863 max(1, stride(A, 2)), tau, work, lwork,
5864 info)
5865 chklapackerror(info[])
5866 if i == 1
5867 lwork = BlasInt(real(work[1]))
5868 resize!(work, lwork)
5869 end
5870 end
5871 A, tau
5872 end
5873 end
5874 end
5875 gehrd!(A::AbstractMatrix) = gehrd!(1, size(A, 1), A)
5876
5877 """
5878 gehrd!(ilo, ihi, A) -> (A, tau)
5879
5880 Converts a matrix `A` to Hessenberg form. If `A` is balanced with `gebal!`
5881 then `ilo` and `ihi` are the outputs of `gebal!`. Otherwise they should be
5882 `ilo = 1` and `ihi = size(A,2)`. `tau` contains the elementary reflectors of
5883 the factorization.
5884 """
5885 gehrd!(ilo::Integer, ihi::Integer, A::AbstractMatrix)
5886
5887 for (orghr, elty) in
5888 ((:dorghr_,:Float64),
5889 (:sorghr_,:Float32),
5890 (:zunghr_,:ComplexF64),
5891 (:cunghr_,:ComplexF32))
5892 @eval begin
5893 # * .. Scalar Arguments ..
5894 # INTEGER IHI, ILO, INFO, LDA, LWORK, N
5895 # * ..
5896 # * .. Array Arguments ..
5897 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
5898 function orghr!(ilo::Integer, ihi::Integer, A::AbstractMatrix{$elty}, tau::AbstractVector{$elty})
5899 require_one_based_indexing(A, tau)
5900 chkstride1(A, tau)
5901 n = checksquare(A)
5902 if n - length(tau) != 1
5903 throw(DimensionMismatch("tau has length $(length(tau)), needs $(n - 1)"))
5904 end
5905 work = Vector{$elty}(undef, 1)
5906 lwork = BlasInt(-1)
5907 info = Ref{BlasInt}()
5908 for i = 1:2 # first call returns lwork as work[1]
5909 ccall((@blasfunc($orghr), libblastrampoline), Cvoid,
5910 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
5911 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
5912 Ptr{BlasInt}),
5913 n, ilo, ihi, A,
5914 max(1, stride(A, 2)), tau, work, lwork,
5915 info)
5916 chklapackerror(info[])
5917 if i == 1
5918 lwork = BlasInt(real(work[1]))
5919 resize!(work, lwork)
5920 end
5921 end
5922 A
5923 end
5924 end
5925 end
5926
5927 """
5928 orghr!(ilo, ihi, A, tau)
5929
5930 Explicitly finds `Q`, the orthogonal/unitary matrix from `gehrd!`. `ilo`,
5931 `ihi`, `A`, and `tau` must correspond to the input/output to `gehrd!`.
5932 """
5933 orghr!(ilo::Integer, ihi::Integer, A::AbstractMatrix, tau::AbstractVector)
5934
5935 for (ormhr, elty) in
5936 ((:dormhr_,:Float64),
5937 (:sormhr_,:Float32),
5938 (:zunmhr_,:ComplexF64),
5939 (:cunmhr_,:ComplexF32))
5940 @eval begin
5941 # .. Scalar Arguments ..
5942 # CHARACTER side, trans
5943 # INTEGER ihi, ilo, info, lda, ldc, lwork, m, n
5944 # ..
5945 # .. Array Arguments ..
5946 # DOUBLE PRECISION a( lda, * ), c( ldc, * ), tau( * ), work( * )
5947 function ormhr!(side::AbstractChar, trans::AbstractChar, ilo::Integer, ihi::Integer, A::AbstractMatrix{$elty},
5948 tau::AbstractVector{$elty}, C::AbstractVecOrMat{$elty})
5949
5950 require_one_based_indexing(A, tau, C)
5951 chkstride1(A, tau, C)
5952 n = checksquare(A)
5953 mC, nC = size(C, 1), size(C, 2)
5954
5955 if n - length(tau) != 1
5956 throw(DimensionMismatch("tau has length $(length(tau)), needs $(n - 1)"))
5957 end
5958 if (side == 'L' && mC != n) || (side == 'R' && nC != n)
5959 throw(DimensionMismatch("A and C matrices are not conformable"))
5960 end
5961
5962 work = Vector{$elty}(undef, 1)
5963 lwork = BlasInt(-1)
5964 info = Ref{BlasInt}()
5965 for i = 1:2 # first call returns lwork as work[1]
5966 ccall((@blasfunc($ormhr), libblastrampoline), Cvoid,
5967 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
5968 Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
5969 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
5970 Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong),
5971 side, trans, mC, nC,
5972 ilo, ihi, A, max(1, stride(A, 2)),
5973 tau, C, max(1, stride(C, 2)), work,
5974 lwork, info, 1, 1)
5975 chklapackerror(info[])
5976 if i == 1
5977 lwork = BlasInt(real(work[1]))
5978 resize!(work, lwork)
5979 end
5980 end
5981 C
5982 end
5983 end
5984 end
5985
5986 for (hseqr, elty) in
5987 ((:zhseqr_,:ComplexF64),
5988 (:chseqr_,:ComplexF32))
5989 @eval begin
5990 # * .. Scalar Arguments ..
5991 # CHARACTER JOB, COMPZ
5992 # INTEGER N, ILO, IHI, LWORK, LDH, LDZ, INFO
5993 # * ..
5994 # * .. Array Arguments ..
5995 # COMPLEX*16 H( LDH, * ), Z( LDZ, * ), WORK( * )
5996 function hseqr!(job::AbstractChar, compz::AbstractChar, ilo::Integer, ihi::Integer,
5997 H::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
5998 require_one_based_indexing(H, Z)
5999 chkstride1(H)
6000 n = checksquare(H)
6001 checksquare(Z) == n || throw(DimensionMismatch())
6002 ldh = max(1, stride(H, 2))
6003 ldz = max(1, stride(Z, 2))
6004 w = similar(H, $elty, n)
6005 work = Vector{$elty}(undef, 1)
6006 lwork = BlasInt(-1)
6007 info = Ref{BlasInt}()
6008 for i = 1:2 # first call returns lwork as work[1]
6009 ccall((@blasfunc($hseqr), libblastrampoline), Cvoid,
6010 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
6011 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6012 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6013 Ptr{BlasInt}),
6014 job, compz, n, ilo, ihi,
6015 H, ldh, w, Z, ldz, work,
6016 lwork, info)
6017 chklapackerror(info[])
6018 if i == 1
6019 lwork = BlasInt(real(work[1]))
6020 resize!(work, lwork)
6021 end
6022 end
6023 H, Z, w
6024 end
6025 end
6026 end
6027
6028 for (hseqr, elty) in
6029 ((:dhseqr_,:Float64),
6030 (:shseqr_,:Float32))
6031 @eval begin
6032 # * .. Scalar Arguments ..
6033 # CHARACTER JOB, COMPZ
6034 # INTEGER N, ILO, IHI, LWORK, LDH, LDZ, INFO
6035 # * ..
6036 # * .. Array Arguments ..
6037 # COMPLEX*16 H( LDH, * ), Z( LDZ, * ), WORK( * )
6038 function hseqr!(job::AbstractChar, compz::AbstractChar, ilo::Integer, ihi::Integer,
6039 H::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
6040 require_one_based_indexing(H, Z)
6041 chkstride1(H)
6042 n = checksquare(H)
6043 checksquare(Z) == n || throw(DimensionMismatch())
6044 ldh = max(1, stride(H, 2))
6045 ldz = max(1, stride(Z, 2))
6046 wr = similar(H, $elty, n)
6047 wi = similar(H, $elty, n)
6048 work = Vector{$elty}(undef, 1)
6049 lwork = BlasInt(-1)
6050 info = Ref{BlasInt}()
6051 for i = 1:2 # first call returns lwork as work[1]
6052 ccall((@blasfunc($hseqr), libblastrampoline), Cvoid,
6053 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
6054 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
6055 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6056 Ptr{BlasInt}),
6057 job, compz, n, ilo, ihi,
6058 H, ldh, wr, wi, Z, ldz, work,
6059 lwork, info)
6060 chklapackerror(info[])
6061 if i == 1
6062 lwork = BlasInt(real(work[1]))
6063 resize!(work, lwork)
6064 end
6065 end
6066 H, Z, complex.(wr, wi)
6067 end
6068 end
6069 end
6070 hseqr!(H::StridedMatrix{T}, Z::StridedMatrix{T}) where {T<:BlasFloat} = hseqr!('S', 'V', 1, size(H, 1), H, Z)
6071 hseqr!(H::StridedMatrix{T}) where {T<:BlasFloat} = hseqr!('S', 'I', 1, size(H, 1), H, similar(H))
6072
6073 """
6074 hseqr!(job, compz, ilo, ihi, H, Z) -> (H, Z, w)
6075
6076 Computes all eigenvalues and (optionally) the Schur factorization of a matrix
6077 reduced to Hessenberg form. If `H` is balanced with `gebal!`
6078 then `ilo` and `ihi` are the outputs of `gebal!`. Otherwise they should be
6079 `ilo = 1` and `ihi = size(H,2)`. `tau` contains the elementary reflectors of
6080 the factorization.
6081 """
6082 hseqr!(job::AbstractChar, compz::AbstractChar, ilo::Integer, ihi::Integer, H::AbstractMatrix, Z::AbstractMatrix)
6083
6084 for (hetrd, elty) in
6085 ((:dsytrd_,Float64),
6086 (:ssytrd_,Float32),
6087 (:zhetrd_,ComplexF64),
6088 (:chetrd_,ComplexF32))
6089 relty = real(elty)
6090 @eval begin
6091
6092 # .. Scalar Arguments ..
6093 # CHARACTER UPLO
6094 # INTEGER INFO, LDA, LWORK, N
6095 # * ..
6096 # * .. Array Arguments ..
6097 # DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * ), WORK( * )
6098 function hetrd!(uplo::AbstractChar, A::AbstractMatrix{$elty})
6099 chkstride1(A)
6100 n = checksquare(A)
6101 chkuplo(uplo)
6102 chkfinite(A) # balancing routines don't support NaNs and Infs
6103 tau = similar(A, $elty, max(0,n - 1))
6104 d = Vector{$relty}(undef, n)
6105 e = Vector{$relty}(undef, max(0,n - 1))
6106 work = Vector{$elty}(undef, 1)
6107 lwork = BlasInt(-1)
6108 info = Ref{BlasInt}()
6109 for i = 1:2 # first call returns lwork as work[1]
6110 ccall((@blasfunc($hetrd), libblastrampoline), Cvoid,
6111 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6112 Ptr{$relty}, Ptr{$relty},
6113 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Clong),
6114 uplo, n, A, max(1, stride(A, 2)), d, e, tau, work, lwork, info, 1)
6115 chklapackerror(info[])
6116 if i == 1
6117 lwork = BlasInt(real(work[1]))
6118 resize!(work, lwork)
6119 end
6120 end
6121 A, tau, d, e
6122 end
6123 end
6124 end
6125
6126 """
6127 hetrd!(uplo, A) -> (A, tau, d, e)
6128
6129 Converts a Hermitian matrix `A` to real-symmetric tridiagonal Hessenberg form.
6130 If `uplo = U`, the upper half of `A` is stored; if `uplo = L`, the lower half is stored.
6131 `tau` contains the elementary reflectors of the factorization, `d` contains the
6132 diagonal and `e` contains the upper/lower diagonal.
6133 """
6134 hetrd!(uplo::AbstractChar, A::AbstractMatrix)
6135
6136 for (orgtr, elty) in
6137 ((:dorgtr_,:Float64),
6138 (:sorgtr_,:Float32),
6139 (:zungtr_,:ComplexF64),
6140 (:cungtr_,:ComplexF32))
6141 @eval begin
6142 # * .. Scalar Arguments ..
6143 # CHARACTER UPLO
6144 # INTEGER INFO, LDA, LWORK, N
6145 # * ..
6146 # * .. Array Arguments ..
6147 # DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
6148 function orgtr!(uplo::AbstractChar, A::AbstractMatrix{$elty}, tau::AbstractVector{$elty})
6149 require_one_based_indexing(A, tau)
6150 chkstride1(A, tau)
6151 n = checksquare(A)
6152 if n - length(tau) != 1
6153 throw(DimensionMismatch("tau has length $(length(tau)), needs $(n - 1)"))
6154 end
6155 chkuplo(uplo)
6156 work = Vector{$elty}(undef, 1)
6157 lwork = BlasInt(-1)
6158 info = Ref{BlasInt}()
6159 for i = 1:2 # first call returns lwork as work[1]
6160 ccall((@blasfunc($orgtr), libblastrampoline), Cvoid,
6161 (Ref{UInt8}, Ref{BlasInt}, Ptr{$elty},
6162 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ref{BlasInt},
6163 Ptr{BlasInt}, Clong),
6164 uplo, n, A,
6165 max(1, stride(A, 2)), tau, work, lwork,
6166 info, 1)
6167 chklapackerror(info[])
6168 if i == 1
6169 lwork = BlasInt(real(work[1]))
6170 resize!(work, lwork)
6171 end
6172 end
6173 A
6174 end
6175 end
6176 end
6177
6178 """
6179 orgtr!(uplo, A, tau)
6180
6181 Explicitly finds `Q`, the orthogonal/unitary matrix from `hetrd!`. `uplo`,
6182 `A`, and `tau` must correspond to the input/output to `hetrd!`.
6183 """
6184 orgtr!(uplo::AbstractChar, A::AbstractMatrix, tau::AbstractVector)
6185
6186 for (ormtr, elty) in
6187 ((:dormtr_,:Float64),
6188 (:sormtr_,:Float32),
6189 (:zunmtr_,:ComplexF64),
6190 (:cunmtr_,:ComplexF32))
6191 @eval begin
6192 # .. Scalar Arguments ..
6193 # CHARACTER side, trans, uplo
6194 # INTEGER info, lda, ldc, lwork, m, n
6195 # ..
6196 # .. Array Arguments ..
6197 # DOUBLE PRECISION a( lda, * ), c( ldc, * ), tau( * ), work( * )
6198 function ormtr!(side::AbstractChar, uplo::AbstractChar, trans::AbstractChar, A::AbstractMatrix{$elty},
6199 tau::AbstractVector{$elty}, C::AbstractVecOrMat{$elty})
6200
6201 require_one_based_indexing(A, tau, C)
6202 chkstride1(A, tau, C)
6203 n = checksquare(A)
6204 chkuplo(uplo)
6205 mC, nC = size(C, 1), size(C, 2)
6206
6207 if n - length(tau) != 1
6208 throw(DimensionMismatch("tau has length $(length(tau)), needs $(n - 1)"))
6209 end
6210 if (side == 'L' && mC != n) || (side == 'R' && nC != n)
6211 throw(DimensionMismatch("A and C matrices are not conformable"))
6212 end
6213
6214 work = Vector{$elty}(undef, 1)
6215 lwork = BlasInt(-1)
6216 info = Ref{BlasInt}()
6217 for i = 1:2 # first call returns lwork as work[1]
6218 ccall((@blasfunc($ormtr), libblastrampoline), Cvoid,
6219 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt},
6220 Ptr{$elty}, Ref{BlasInt},
6221 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6222 Ref{BlasInt}, Ptr{BlasInt}, Clong, Clong, Clong),
6223 side, uplo, trans, mC, nC,
6224 A, max(1, stride(A, 2)),
6225 tau, C, max(1, stride(C, 2)), work,
6226 lwork, info, 1, 1, 1)
6227 chklapackerror(info[])
6228 if i == 1
6229 lwork = BlasInt(real(work[1]))
6230 resize!(work, lwork)
6231 end
6232 end
6233 C
6234 end
6235 end
6236 end
6237
6238 for (gees, gges, gges3, elty) in
6239 ((:dgees_,:dgges_,:dgges3_,:Float64),
6240 (:sgees_,:sgges_,:sgges3_,:Float32))
6241 @eval begin
6242 # .. Scalar Arguments ..
6243 # CHARACTER JOBVS, SORT
6244 # INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
6245 # ..
6246 # .. Array Arguments ..
6247 # LOGICAL BWORK( * )
6248 # DOUBLE PRECISION A( LDA, * ), VS( LDVS, * ), WI( * ), WORK( * ),
6249 # $ WR( * )
6250 function gees!(jobvs::AbstractChar, A::AbstractMatrix{$elty})
6251 require_one_based_indexing(A)
6252 chkstride1(A)
6253 n = checksquare(A)
6254 sdim = Vector{BlasInt}(undef, 1)
6255 wr = similar(A, $elty, n)
6256 wi = similar(A, $elty, n)
6257 vs = similar(A, $elty, jobvs == 'V' ? n : 0, n)
6258 ldvs = max(size(vs, 1), 1)
6259 work = Vector{$elty}(undef, 1)
6260 lwork = BlasInt(-1)
6261 info = Ref{BlasInt}()
6262 for i = 1:2 # first call returns lwork as work[1]
6263 ccall((@blasfunc($gees), libblastrampoline), Cvoid,
6264 (Ref{UInt8}, Ref{UInt8}, Ptr{Cvoid}, Ref{BlasInt},
6265 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ptr{$elty},
6266 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6267 Ref{BlasInt}, Ptr{Cvoid}, Ref{BlasInt}, Clong, Clong),
6268 jobvs, 'N', C_NULL, n,
6269 A, max(1, stride(A, 2)), sdim, wr,
6270 wi, vs, ldvs, work,
6271 lwork, C_NULL, info, 1, 1)
6272 chklapackerror(info[])
6273 if i == 1
6274 lwork = BlasInt(real(work[1]))
6275 resize!(work, lwork)
6276 end
6277 end
6278 A, vs, iszero(wi) ? wr : complex.(wr, wi)
6279 end
6280
6281 # * .. Scalar Arguments ..
6282 # CHARACTER JOBVSL, JOBVSR, SORT
6283 # INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
6284 # * ..
6285 # * .. Array Arguments ..
6286 # LOGICAL BWORK( * )
6287 # DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
6288 # $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
6289 # $ VSR( LDVSR, * ), WORK( * )
6290 function gges!(jobvsl::AbstractChar, jobvsr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
6291 chkstride1(A, B)
6292 n, m = checksquare(A, B)
6293 if n != m
6294 throw(DimensionMismatch("dimensions of A, ($n,$n), and B, ($m,$m), must match"))
6295 end
6296 sdim = BlasInt(0)
6297 alphar = similar(A, $elty, n)
6298 alphai = similar(A, $elty, n)
6299 beta = similar(A, $elty, n)
6300 ldvsl = jobvsl == 'V' ? max(1, n) : 1
6301 vsl = similar(A, $elty, ldvsl, n)
6302 ldvsr = jobvsr == 'V' ? max(1, n) : 1
6303 vsr = similar(A, $elty, ldvsr, n)
6304 work = Vector{$elty}(undef, 1)
6305 lwork = BlasInt(-1)
6306 info = Ref{BlasInt}()
6307 for i = 1:2 # first call returns lwork as work[1]
6308 ccall((@blasfunc($gges), libblastrampoline), Cvoid,
6309 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ptr{Cvoid},
6310 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6311 Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
6312 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6313 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{Cvoid},
6314 Ref{BlasInt}, Clong, Clong, Clong),
6315 jobvsl, jobvsr, 'N', C_NULL,
6316 n, A, max(1,stride(A, 2)), B,
6317 max(1,stride(B, 2)), sdim, alphar, alphai,
6318 beta, vsl, ldvsl, vsr,
6319 ldvsr, work, lwork, C_NULL,
6320 info, 1, 1, 1)
6321 chklapackerror(info[])
6322 if i == 1
6323 lwork = BlasInt(real(work[1]))
6324 resize!(work, lwork)
6325 end
6326 end
6327 A, B, complex.(alphar, alphai), beta, vsl[1:(jobvsl == 'V' ? n : 0),:], vsr[1:(jobvsr == 'V' ? n : 0),:]
6328 end
6329
6330 # * .. Scalar Arguments ..
6331 # CHARACTER JOBVSL, JOBVSR, SORT
6332 # INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
6333 # * ..
6334 # * .. Array Arguments ..
6335 # LOGICAL BWORK( * )
6336 # DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
6337 # $ B( LDB, * ), BETA( * ), VSL( LDVSL, * ),
6338 # $ VSR( LDVSR, * ), WORK( * )
6339 function gges3!(jobvsl::AbstractChar, jobvsr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
6340 chkstride1(A, B)
6341 n, m = checksquare(A, B)
6342 if n != m
6343 throw(DimensionMismatch("dimensions of A, ($n,$n), and B, ($m,$m), must match"))
6344 end
6345 sdim = BlasInt(0)
6346 alphar = similar(A, $elty, n)
6347 alphai = similar(A, $elty, n)
6348 beta = similar(A, $elty, n)
6349 ldvsl = jobvsl == 'V' ? max(1, n) : 1
6350 vsl = similar(A, $elty, ldvsl, n)
6351 ldvsr = jobvsr == 'V' ? max(1, n) : 1
6352 vsr = similar(A, $elty, ldvsr, n)
6353 work = Vector{$elty}(undef, 1)
6354 lwork = BlasInt(-1)
6355 info = Ref{BlasInt}()
6356 for i = 1:2 # first call returns lwork as work[1]
6357 ccall((@blasfunc($gges3), libblastrampoline), Cvoid,
6358 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ptr{Cvoid},
6359 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6360 Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
6361 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6362 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{Cvoid},
6363 Ref{BlasInt}, Clong, Clong, Clong),
6364 jobvsl, jobvsr, 'N', C_NULL,
6365 n, A, max(1,stride(A, 2)), B,
6366 max(1,stride(B, 2)), sdim, alphar, alphai,
6367 beta, vsl, ldvsl, vsr,
6368 ldvsr, work, lwork, C_NULL,
6369 info, 1, 1, 1)
6370 chklapackerror(info[])
6371 if i == 1
6372 lwork = BlasInt(real(work[1]))
6373 resize!(work, lwork)
6374 end
6375 end
6376 A, B, complex.(alphar, alphai), beta, vsl[1:(jobvsl == 'V' ? n : 0),:], vsr[1:(jobvsr == 'V' ? n : 0),:]
6377 end
6378 end
6379 end
6380
6381 for (gees, gges, gges3, elty, relty) in
6382 ((:zgees_,:zgges_,:zgges3_,:ComplexF64,:Float64),
6383 (:cgees_,:cgges_,:cgges3_,:ComplexF32,:Float32))
6384 @eval begin
6385 # * .. Scalar Arguments ..
6386 # CHARACTER JOBVS, SORT
6387 # INTEGER INFO, LDA, LDVS, LWORK, N, SDIM
6388 # * ..
6389 # * .. Array Arguments ..
6390 # LOGICAL BWORK( * )
6391 # DOUBLE PRECISION RWORK( * )
6392 # COMPLEX*16 A( LDA, * ), VS( LDVS, * ), W( * ), WORK( * )
6393 function gees!(jobvs::AbstractChar, A::AbstractMatrix{$elty})
6394 require_one_based_indexing(A)
6395 chkstride1(A)
6396 n = checksquare(A)
6397 sort = 'N'
6398 sdim = BlasInt(0)
6399 w = similar(A, $elty, n)
6400 vs = similar(A, $elty, jobvs == 'V' ? n : 1, n)
6401 ldvs = max(size(vs, 1), 1)
6402 work = Vector{$elty}(undef, 1)
6403 lwork = BlasInt(-1)
6404 rwork = Vector{$relty}(undef, n)
6405 info = Ref{BlasInt}()
6406 for i = 1:2 # first call returns lwork as work[1]
6407 ccall((@blasfunc($gees), libblastrampoline), Cvoid,
6408 (Ref{UInt8}, Ref{UInt8}, Ptr{Cvoid}, Ref{BlasInt},
6409 Ptr{$elty}, Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty},
6410 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6411 Ptr{$relty}, Ptr{Cvoid}, Ref{BlasInt}, Clong, Clong),
6412 jobvs, sort, C_NULL, n,
6413 A, max(1, stride(A, 2)), sdim, w,
6414 vs, ldvs, work, lwork,
6415 rwork, C_NULL, info, 1, 1)
6416 chklapackerror(info[])
6417 if i == 1
6418 lwork = BlasInt(real(work[1]))
6419 resize!(work, lwork)
6420 end
6421 end
6422 A, vs, w
6423 end
6424
6425 # * .. Scalar Arguments ..
6426 # CHARACTER JOBVSL, JOBVSR, SORT
6427 # INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
6428 # * ..
6429 # * .. Array Arguments ..
6430 # LOGICAL BWORK( * )
6431 # DOUBLE PRECISION RWORK( * )
6432 # COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
6433 # $ BETA( * ), VSL( LDVSL, * ), VSR( LDVSR, * ),
6434 # $ WORK( * )
6435 function gges!(jobvsl::AbstractChar, jobvsr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
6436 chkstride1(A, B)
6437 n, m = checksquare(A, B)
6438 if n != m
6439 throw(DimensionMismatch("dimensions of A, ($n,$n), and B, ($m,$m), must match"))
6440 end
6441 sdim = BlasInt(0)
6442 alpha = similar(A, $elty, n)
6443 beta = similar(A, $elty, n)
6444 ldvsl = jobvsl == 'V' ? max(1, n) : 1
6445 vsl = similar(A, $elty, ldvsl, n)
6446 ldvsr = jobvsr == 'V' ? max(1, n) : 1
6447 vsr = similar(A, $elty, ldvsr, n)
6448 work = Vector{$elty}(undef, 1)
6449 lwork = BlasInt(-1)
6450 rwork = Vector{$relty}(undef, 8n)
6451 info = Ref{BlasInt}()
6452 for i = 1:2 # first call returns lwork as work[1]
6453 ccall((@blasfunc($gges), libblastrampoline), Cvoid,
6454 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ptr{Cvoid},
6455 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6456 Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
6457 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6458 Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ptr{Cvoid},
6459 Ref{BlasInt}, Clong, Clong, Clong),
6460 jobvsl, jobvsr, 'N', C_NULL,
6461 n, A, max(1, stride(A, 2)), B,
6462 max(1, stride(B, 2)), sdim, alpha, beta,
6463 vsl, ldvsl, vsr, ldvsr,
6464 work, lwork, rwork, C_NULL,
6465 info, 1, 1, 1)
6466 chklapackerror(info[])
6467 if i == 1
6468 lwork = BlasInt(real(work[1]))
6469 resize!(work, lwork)
6470 end
6471 end
6472 A, B, alpha, beta, vsl[1:(jobvsl == 'V' ? n : 0),:], vsr[1:(jobvsr == 'V' ? n : 0),:]
6473 end
6474
6475 # * .. Scalar Arguments ..
6476 # CHARACTER JOBVSL, JOBVSR, SORT
6477 # INTEGER INFO, LDA, LDB, LDVSL, LDVSR, LWORK, N, SDIM
6478 # * ..
6479 # * .. Array Arguments ..
6480 # LOGICAL BWORK( * )
6481 # DOUBLE PRECISION RWORK( * )
6482 # COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
6483 # $ BETA( * ), VSL( LDVSL, * ), VSR( LDVSR, * ),
6484 # $ WORK( * )
6485 function gges3!(jobvsl::AbstractChar, jobvsr::AbstractChar, A::AbstractMatrix{$elty}, B::AbstractMatrix{$elty})
6486 chkstride1(A, B)
6487 n, m = checksquare(A, B)
6488 if n != m
6489 throw(DimensionMismatch("dimensions of A, ($n,$n), and B, ($m,$m), must match"))
6490 end
6491 sdim = BlasInt(0)
6492 alpha = similar(A, $elty, n)
6493 beta = similar(A, $elty, n)
6494 ldvsl = jobvsl == 'V' ? max(1, n) : 1
6495 vsl = similar(A, $elty, ldvsl, n)
6496 ldvsr = jobvsr == 'V' ? max(1, n) : 1
6497 vsr = similar(A, $elty, ldvsr, n)
6498 work = Vector{$elty}(undef, 1)
6499 lwork = BlasInt(-1)
6500 rwork = Vector{$relty}(undef, 8n)
6501 info = Ref{BlasInt}()
6502 for i = 1:2 # first call returns lwork as work[1]
6503 ccall((@blasfunc($gges3), libblastrampoline), Cvoid,
6504 (Ref{UInt8}, Ref{UInt8}, Ref{UInt8}, Ptr{Cvoid},
6505 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6506 Ref{BlasInt}, Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
6507 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6508 Ptr{$elty}, Ref{BlasInt}, Ptr{$relty}, Ptr{Cvoid},
6509 Ref{BlasInt}, Clong, Clong, Clong),
6510 jobvsl, jobvsr, 'N', C_NULL,
6511 n, A, max(1, stride(A, 2)), B,
6512 max(1, stride(B, 2)), sdim, alpha, beta,
6513 vsl, ldvsl, vsr, ldvsr,
6514 work, lwork, rwork, C_NULL,
6515 info, 1, 1, 1)
6516 chklapackerror(info[])
6517 if i == 1
6518 lwork = BlasInt(real(work[1]))
6519 resize!(work, lwork)
6520 end
6521 end
6522 A, B, alpha, beta, vsl[1:(jobvsl == 'V' ? n : 0),:], vsr[1:(jobvsr == 'V' ? n : 0),:]
6523 end
6524 end
6525 end
6526
6527 """
6528 gees!(jobvs, A) -> (A, vs, w)
6529
6530 Computes the eigenvalues (`jobvs = N`) or the eigenvalues and Schur
6531 vectors (`jobvs = V`) of matrix `A`. `A` is overwritten by its Schur form.
6532
6533 Returns `A`, `vs` containing the Schur vectors, and `w`, containing the
6534 eigenvalues.
6535 """
6536 gees!(jobvs::AbstractChar, A::AbstractMatrix)
6537
6538
6539 """
6540 gges!(jobvsl, jobvsr, A, B) -> (A, B, alpha, beta, vsl, vsr)
6541
6542 Computes the generalized eigenvalues, generalized Schur form, left Schur
6543 vectors (`jobsvl = V`), or right Schur vectors (`jobvsr = V`) of `A` and
6544 `B`.
6545
6546 The generalized eigenvalues are returned in `alpha` and `beta`. The left Schur
6547 vectors are returned in `vsl` and the right Schur vectors are returned in `vsr`.
6548 """
6549 gges!(jobvsl::AbstractChar, jobvsr::AbstractChar, A::AbstractMatrix, B::AbstractMatrix)
6550
6551 """
6552 gges3!(jobvsl, jobvsr, A, B) -> (A, B, alpha, beta, vsl, vsr)
6553
6554 Computes the generalized eigenvalues, generalized Schur form, left Schur
6555 vectors (`jobsvl = V`), or right Schur vectors (`jobvsr = V`) of `A` and
6556 `B` using a blocked algorithm. This function requires LAPACK 3.6.0.
6557
6558 The generalized eigenvalues are returned in `alpha` and `beta`. The left Schur
6559 vectors are returned in `vsl` and the right Schur vectors are returned in `vsr`.
6560 """
6561 gges3!(jobvsl::AbstractChar, jobvsr::AbstractChar, A::AbstractMatrix, B::AbstractMatrix)
6562
6563 for (trexc, trsen, tgsen, elty) in
6564 ((:dtrexc_, :dtrsen_, :dtgsen_, :Float64),
6565 (:strexc_, :strsen_, :stgsen_, :Float32))
6566 @eval begin
6567 # * .. Scalar Arguments ..
6568 # CHARACTER COMPQ
6569 # INTEGER IFST, ILST, INFO, LDQ, LDT, N
6570 # * ..
6571 # * .. Array Arguments ..
6572 # DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
6573 function trexc!(compq::AbstractChar, ifst::BlasInt, ilst::BlasInt, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty})
6574 chkstride1(T, Q)
6575 n = checksquare(T)
6576 ldt = max(1, stride(T, 2))
6577 ldq = max(1, stride(Q, 2))
6578 work = Vector{$elty}(undef, n)
6579 info = Ref{BlasInt}()
6580 ccall((@blasfunc($trexc), libblastrampoline), Cvoid,
6581 (Ref{UInt8}, Ref{BlasInt},
6582 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6583 Ref{BlasInt}, Ref{BlasInt},
6584 Ptr{$elty}, Ptr{BlasInt}, Clong),
6585 compq, n,
6586 T, ldt, Q, ldq,
6587 ifst, ilst,
6588 work, info, 1)
6589 chklapackerror(info[])
6590 T, Q
6591 end
6592 trexc!(ifst::BlasInt, ilst::BlasInt, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}) =
6593 trexc!('V', ifst, ilst, T, Q)
6594
6595 # * .. Scalar Arguments ..
6596 # CHARACTER COMPQ, JOB
6597 # INTEGER INFO, LDQ, LDT, LIWORK, LWORK, M, N
6598 # DOUBLE PRECISION S, SEP
6599 # * ..
6600 # * .. Array Arguments ..
6601 # LOGICAL SELECT( * )
6602 # INTEGER IWORK( * )
6603 # DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WI( * ), WORK( * ), WR( * )
6604 function trsen!(job::AbstractChar, compq::AbstractChar, select::AbstractVector{BlasInt},
6605 T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty})
6606 chkstride1(T, Q, select)
6607 n = checksquare(T)
6608 ldt = max(1, stride(T, 2))
6609 ldq = max(1, stride(Q, 2))
6610 wr = similar(T, $elty, n)
6611 wi = similar(T, $elty, n)
6612 m = sum(select)
6613 work = Vector{$elty}(undef, 1)
6614 lwork = BlasInt(-1)
6615 iwork = Vector{BlasInt}(undef, 1)
6616 liwork = BlasInt(-1)
6617 info = Ref{BlasInt}()
6618 select = convert(Array{BlasInt}, select)
6619 s = Ref{$elty}(zero($elty))
6620 sep = Ref{$elty}(zero($elty))
6621 for i = 1:2 # first call returns lwork as work[1] and liwork as iwork[1]
6622 ccall((@blasfunc($trsen), libblastrampoline), Cvoid,
6623 (Ref{UInt8}, Ref{UInt8}, Ptr{BlasInt}, Ref{BlasInt},
6624 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6625 Ptr{$elty}, Ptr{$elty}, Ref{BlasInt}, Ref{$elty}, Ref{$elty},
6626 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
6627 Ptr{BlasInt}, Clong, Clong),
6628 job, compq, select, n,
6629 T, ldt, Q, ldq,
6630 wr, wi, m, s, sep,
6631 work, lwork, iwork, liwork,
6632 info, 1, 1)
6633 chklapackerror(info[])
6634 if i == 1 # only estimated optimal lwork, liwork
6635 lwork = BlasInt(real(work[1]))
6636 resize!(work, lwork)
6637 liwork = BlasInt(real(iwork[1]))
6638 resize!(iwork, liwork)
6639 end
6640 end
6641 T, Q, iszero(wi) ? wr : complex.(wr, wi), s[], sep[]
6642 end
6643 trsen!(select::AbstractVector{BlasInt}, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}) =
6644 trsen!('N', 'V', select, T, Q)
6645
6646 # .. Scalar Arguments ..
6647 # LOGICAL WANTQ, WANTZ
6648 # INTEGER IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
6649 # $ M, N
6650 # DOUBLE PRECISION PL, PR
6651 # ..
6652 # .. Array Arguments ..
6653 # LOGICAL SELECT( * )
6654 # INTEGER IWORK( * )
6655 # DOUBLE PRECISION A( LDA, * ), ALPHAI( * ), ALPHAR( * ),
6656 # $ B( LDB, * ), BETA( * ), DIF( * ), Q( LDQ, * ),
6657 # $ WORK( * ), Z( LDZ, * )
6658 # ..
6659 function tgsen!(select::AbstractVector{BlasInt}, S::AbstractMatrix{$elty}, T::AbstractMatrix{$elty},
6660 Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
6661 chkstride1(select, S, T, Q, Z)
6662 n, nt, nq, nz = checksquare(S, T, Q, Z)
6663 if n != nt
6664 throw(DimensionMismatch("dimensions of S, ($n,$n), and T, ($nt,$nt), must match"))
6665 end
6666 if n != nq
6667 throw(DimensionMismatch("dimensions of S, ($n,$n), and Q, ($nq,$nq), must match"))
6668 end
6669 if n != nz
6670 throw(DimensionMismatch("dimensions of S, ($n,$n), and Z, ($nz,$nz), must match"))
6671 end
6672 lds = max(1, stride(S, 2))
6673 ldt = max(1, stride(T, 2))
6674 ldq = max(1, stride(Q, 2))
6675 ldz = max(1, stride(Z, 2))
6676 m = sum(select)
6677 alphai = similar(T, $elty, n)
6678 alphar = similar(T, $elty, n)
6679 beta = similar(T, $elty, n)
6680 lwork = BlasInt(-1)
6681 work = Vector{$elty}(undef, 1)
6682 liwork = BlasInt(-1)
6683 iwork = Vector{BlasInt}(undef, 1)
6684 info = Ref{BlasInt}()
6685 select = convert(Array{BlasInt}, select)
6686 for i = 1:2 # first call returns lwork as work[1] and liwork as iwork[1]
6687 ccall((@blasfunc($tgsen), libblastrampoline), Cvoid,
6688 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
6689 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6690 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty}, Ptr{$elty},
6691 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6692 Ref{BlasInt}, Ptr{Cvoid}, Ptr{Cvoid}, Ptr{Cvoid},
6693 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
6694 Ptr{BlasInt}),
6695 0, 1, 1, select,
6696 n, S, lds, T,
6697 ldt, alphar, alphai, beta,
6698 Q, ldq, Z, ldz,
6699 m, C_NULL, C_NULL, C_NULL,
6700 work, lwork, iwork, liwork,
6701 info)
6702 chklapackerror(info[])
6703 if i == 1 # only estimated optimal lwork, liwork
6704 lwork = BlasInt(real(work[1]))
6705 resize!(work, lwork)
6706 liwork = BlasInt(real(iwork[1]))
6707 resize!(iwork, liwork)
6708 end
6709 end
6710 S, T, complex.(alphar, alphai), beta, Q, Z
6711 end
6712 end
6713 end
6714
6715 for (trexc, trsen, tgsen, elty, relty) in
6716 ((:ztrexc_, :ztrsen_, :ztgsen_, :ComplexF64, :Float64),
6717 (:ctrexc_, :ctrsen_, :ctgsen_, :ComplexF32, :Float32))
6718 @eval begin
6719 # .. Scalar Arguments ..
6720 # CHARACTER COMPQ
6721 # INTEGER IFST, ILST, INFO, LDQ, LDT, N
6722 # ..
6723 # .. Array Arguments ..
6724 # DOUBLE PRECISION Q( LDQ, * ), T( LDT, * ), WORK( * )
6725 function trexc!(compq::AbstractChar, ifst::BlasInt, ilst::BlasInt, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty})
6726 chkstride1(T, Q)
6727 n = checksquare(T)
6728 ldt = max(1, stride(T, 2))
6729 ldq = max(1, stride(Q, 2))
6730 info = Ref{BlasInt}()
6731 ccall((@blasfunc($trexc), libblastrampoline), Cvoid,
6732 (Ref{UInt8}, Ref{BlasInt},
6733 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6734 Ref{BlasInt}, Ref{BlasInt},
6735 Ptr{BlasInt}, Clong),
6736 compq, n,
6737 T, ldt, Q, ldq,
6738 ifst, ilst,
6739 info, 1)
6740 chklapackerror(info[])
6741 T, Q
6742 end
6743 trexc!(ifst::BlasInt, ilst::BlasInt, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}) =
6744 trexc!('V', ifst, ilst, T, Q)
6745
6746 # .. Scalar Arguments ..
6747 # CHARACTER COMPQ, JOB
6748 # INTEGER INFO, LDQ, LDT, LWORK, M, N
6749 # DOUBLE PRECISION S, SEP
6750 # ..
6751 # .. Array Arguments ..
6752 # LOGICAL SELECT( * )
6753 # COMPLEX Q( LDQ, * ), T( LDT, * ), W( * ), WORK( * )
6754 function trsen!(job::AbstractChar, compq::AbstractChar, select::AbstractVector{BlasInt},
6755 T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty})
6756 chkstride1(select, T, Q)
6757 n = checksquare(T)
6758 ldt = max(1, stride(T, 2))
6759 ldq = max(1, stride(Q, 2))
6760 w = similar(T, $elty, n)
6761 m = sum(select)
6762 work = Vector{$elty}(undef, 1)
6763 lwork = BlasInt(-1)
6764 info = Ref{BlasInt}()
6765 select = convert(Array{BlasInt}, select)
6766 s = Ref{$relty}(zero($relty))
6767 sep = Ref{$relty}(zero($relty))
6768 for i = 1:2 # first call returns lwork as work[1]
6769 ccall((@blasfunc($trsen), libblastrampoline), Cvoid,
6770 (Ref{UInt8}, Ref{UInt8}, Ptr{BlasInt}, Ref{BlasInt},
6771 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6772 Ptr{$elty}, Ref{BlasInt}, Ref{$relty}, Ref{$relty},
6773 Ptr{$elty}, Ref{BlasInt},
6774 Ptr{BlasInt}, Clong, Clong),
6775 job, compq, select, n,
6776 T, ldt, Q, ldq,
6777 w, m, s, sep,
6778 work, lwork,
6779 info, 1, 1)
6780 chklapackerror(info[])
6781 if i == 1 # only estimated optimal lwork, liwork
6782 lwork = BlasInt(real(work[1]))
6783 resize!(work, lwork)
6784 end
6785 end
6786 T, Q, w, s[], sep[]
6787 end
6788 trsen!(select::AbstractVector{BlasInt}, T::AbstractMatrix{$elty}, Q::AbstractMatrix{$elty}) =
6789 trsen!('N', 'V', select, T, Q)
6790
6791 # .. Scalar Arguments ..
6792 # LOGICAL WANTQ, WANTZ
6793 # INTEGER IJOB, INFO, LDA, LDB, LDQ, LDZ, LIWORK, LWORK,
6794 # $ M, N
6795 # DOUBLE PRECISION PL, PR
6796 # ..
6797 # .. Array Arguments ..
6798 # LOGICAL SELECT( * )
6799 # INTEGER IWORK( * )
6800 # DOUBLE PRECISION DIF( * )
6801 # COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
6802 # $ BETA( * ), Q( LDQ, * ), WORK( * ), Z( LDZ, * )
6803 # ..
6804 function tgsen!(select::AbstractVector{BlasInt}, S::AbstractMatrix{$elty}, T::AbstractMatrix{$elty},
6805 Q::AbstractMatrix{$elty}, Z::AbstractMatrix{$elty})
6806 chkstride1(select, S, T, Q, Z)
6807 n, nt, nq, nz = checksquare(S, T, Q, Z)
6808 if n != nt
6809 throw(DimensionMismatch("dimensions of S, ($n,$n), and T, ($nt,$nt), must match"))
6810 end
6811 if n != nq
6812 throw(DimensionMismatch("dimensions of S, ($n,$n), and Q, ($nq,$nq), must match"))
6813 end
6814 if n != nz
6815 throw(DimensionMismatch("dimensions of S, ($n,$n), and Z, ($nz,$nz), must match"))
6816 end
6817 lds = max(1, stride(S, 2))
6818 ldt = max(1, stride(T, 2))
6819 ldq = max(1, stride(Q, 2))
6820 ldz = max(1, stride(Z, 2))
6821 m = sum(select)
6822 alpha = similar(T, $elty, n)
6823 beta = similar(T, $elty, n)
6824 lwork = BlasInt(-1)
6825 work = Vector{$elty}(undef, 1)
6826 liwork = BlasInt(-1)
6827 iwork = Vector{BlasInt}(undef, 1)
6828 info = Ref{BlasInt}()
6829 select = convert(Array{BlasInt}, select)
6830 for i = 1:2 # first call returns lwork as work[1] and liwork as iwork[1]
6831 ccall((@blasfunc($tgsen), libblastrampoline), Cvoid,
6832 (Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt}, Ptr{BlasInt},
6833 Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty},
6834 Ref{BlasInt}, Ptr{$elty}, Ptr{$elty},
6835 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6836 Ref{BlasInt}, Ptr{Cvoid}, Ptr{Cvoid}, Ptr{Cvoid},
6837 Ptr{$elty}, Ref{BlasInt}, Ptr{BlasInt}, Ref{BlasInt},
6838 Ptr{BlasInt}),
6839 0, 1, 1, select,
6840 n, S, lds, T,
6841 ldt, alpha, beta,
6842 Q, ldq, Z, ldz,
6843 m, C_NULL, C_NULL, C_NULL,
6844 work, lwork, iwork, liwork,
6845 info)
6846 chklapackerror(info[])
6847 if i == 1 # only estimated optimal lwork, liwork
6848 lwork = BlasInt(real(work[1]))
6849 resize!(work, lwork)
6850 liwork = BlasInt(real(iwork[1]))
6851 resize!(iwork, liwork)
6852 end
6853 end
6854 S, T, alpha, beta, Q, Z
6855 end
6856 end
6857 end
6858
6859 """
6860 trexc!(compq, ifst, ilst, T, Q) -> (T, Q)
6861 trexc!(ifst, ilst, T, Q) -> (T, Q)
6862
6863 Reorder the Schur factorization `T` of a matrix, such that the diagonal block
6864 of `T` with row index `ifst` is moved to row index `ilst`. If `compq = V`, the Schur
6865 vectors `Q` are reordered. If `compq = N` they are not modified. The 4-arg method
6866 calls the 5-arg method with `compq = V`.
6867 """
6868 trexc!(compq::AbstractChar, ifst::BlasInt, ilst::BlasInt, T::AbstractMatrix, Q::AbstractMatrix)
6869
6870 """
6871 trsen!(job, compq, select, T, Q) -> (T, Q, w, s, sep)
6872 trsen!(select, T, Q) -> (T, Q, w, s, sep)
6873
6874 Reorder the Schur factorization of a matrix and optionally finds reciprocal
6875 condition numbers. If `job = N`, no condition numbers are found. If `job = E`,
6876 only the condition number for this cluster of eigenvalues is found. If
6877 `job = V`, only the condition number for the invariant subspace is found.
6878 If `job = B` then the condition numbers for the cluster and subspace are
6879 found. If `compq = V` the Schur vectors `Q` are updated. If `compq = N`
6880 the Schur vectors are not modified. `select` determines which
6881 eigenvalues are in the cluster. The 3-arg method calls the 5-arg method
6882 with `job = N` and `compq = V`.
6883
6884 Returns `T`, `Q`, reordered eigenvalues in `w`, the condition number of the
6885 cluster of eigenvalues `s`, and the condition number of the invariant subspace
6886 `sep`.
6887 """
6888 trsen!(compq::AbstractChar, job::AbstractChar, select::AbstractVector{BlasInt}, T::AbstractMatrix, Q::AbstractMatrix)
6889
6890 """
6891 tgsen!(select, S, T, Q, Z) -> (S, T, alpha, beta, Q, Z)
6892
6893 Reorders the vectors of a generalized Schur decomposition. `select` specifies
6894 the eigenvalues in each cluster.
6895 """
6896 tgsen!(select::AbstractVector{BlasInt}, S::AbstractMatrix, T::AbstractMatrix, Q::AbstractMatrix, Z::AbstractMatrix)
6897
6898 for (fn, elty, relty) in ((:dtrsyl_, :Float64, :Float64),
6899 (:strsyl_, :Float32, :Float32),
6900 (:ztrsyl_, :ComplexF64, :Float64),
6901 (:ctrsyl_, :ComplexF32, :Float32))
6902 @eval begin
6903 function trsyl!(transa::AbstractChar, transb::AbstractChar, A::AbstractMatrix{$elty},
6904 B::AbstractMatrix{$elty}, C::AbstractMatrix{$elty}, isgn::Int=1)
6905 require_one_based_indexing(A, B, C)
6906 chkstride1(A, B, C)
6907 m, n = checksquare(A), checksquare(B)
6908 lda = max(1, stride(A, 2))
6909 ldb = max(1, stride(B, 2))
6910 m1, n1 = size(C)
6911 if m != m1 || n != n1
6912 throw(DimensionMismatch("dimensions of A, ($m,$n), and C, ($m1,$n1), must match"))
6913 end
6914 ldc = max(1, stride(C, 2))
6915 scale = Ref{$relty}()
6916 info = Ref{BlasInt}()
6917 ccall((@blasfunc($fn), libblastrampoline), Cvoid,
6918 (Ref{UInt8}, Ref{UInt8}, Ref{BlasInt}, Ref{BlasInt}, Ref{BlasInt},
6919 Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt}, Ptr{$elty}, Ref{BlasInt},
6920 Ptr{$relty}, Ptr{BlasInt}, Clong, Clong),
6921 transa, transb, isgn, m, n,
6922 A, lda, B, ldb, C, ldc,
6923 scale, info, 1, 1)
6924 chklapackerror(info[])
6925 C, scale[]
6926 end
6927 end
6928 end
6929
6930 """
6931 trsyl!(transa, transb, A, B, C, isgn=1) -> (C, scale)
6932
6933 Solves the Sylvester matrix equation `A * X +/- X * B = scale*C` where `A` and
6934 `B` are both quasi-upper triangular. If `transa = N`, `A` is not modified.
6935 If `transa = T`, `A` is transposed. If `transa = C`, `A` is conjugate
6936 transposed. Similarly for `transb` and `B`. If `isgn = 1`, the equation
6937 `A * X + X * B = scale * C` is solved. If `isgn = -1`, the equation
6938 `A * X - X * B = scale * C` is solved.
6939
6940 Returns `X` (overwriting `C`) and `scale`.
6941 """
6942 trsyl!(transa::AbstractChar, transb::AbstractChar, A::AbstractMatrix, B::AbstractMatrix, C::AbstractMatrix, isgn::Int=1)
6943
6944 end # module