1// Copyright ©2016 The Gonum Authors. All rights reserved.
2// Use of this source code is governed by a BSD-style
3// license that can be found in the LICENSE file.
4
5package gonum
6
7import (
8	"math"
9
10	"gonum.org/v1/gonum/blas"
11	"gonum.org/v1/gonum/blas/blas64"
12	"gonum.org/v1/gonum/lapack"
13)
14
15// Dtrevc3 computes some or all of the right and/or left eigenvectors of an n×n
16// upper quasi-triangular matrix T in Schur canonical form. Matrices of this
17// type are produced by the Schur factorization of a real general matrix A
18//  A = Q T Qᵀ,
19// as computed by Dhseqr.
20//
21// The right eigenvector x of T corresponding to an
22// eigenvalue λ is defined by
23//  T x = λ x,
24// and the left eigenvector y is defined by
25//  yᵀ T = λ yᵀ.
26//
27// The eigenvalues are read directly from the diagonal blocks of T.
28//
29// This routine returns the matrices X and/or Y of right and left eigenvectors
30// of T, or the products Q*X and/or Q*Y, where Q is an input matrix. If Q is the
31// orthogonal factor that reduces a matrix A to Schur form T, then Q*X and Q*Y
32// are the matrices of right and left eigenvectors of A.
33//
34// If side == lapack.EVRight, only right eigenvectors will be computed.
35// If side == lapack.EVLeft, only left eigenvectors will be computed.
36// If side == lapack.EVBoth, both right and left eigenvectors will be computed.
37// For other values of side, Dtrevc3 will panic.
38//
39// If howmny == lapack.EVAll, all right and/or left eigenvectors will be
40// computed.
41// If howmny == lapack.EVAllMulQ, all right and/or left eigenvectors will be
42// computed and multiplied from left by the matrices in VR and/or VL.
43// If howmny == lapack.EVSelected, right and/or left eigenvectors will be
44// computed as indicated by selected.
45// For other values of howmny, Dtrevc3 will panic.
46//
47// selected specifies which eigenvectors will be computed. It must have length n
48// if howmny == lapack.EVSelected, and it is not referenced otherwise.
49// If w_j is a real eigenvalue, the corresponding real eigenvector will be
50// computed if selected[j] is true.
51// If w_j and w_{j+1} are the real and imaginary parts of a complex eigenvalue,
52// the corresponding complex eigenvector is computed if either selected[j] or
53// selected[j+1] is true, and on return selected[j] will be set to true and
54// selected[j+1] will be set to false.
55//
56// VL and VR are n×mm matrices. If howmny is lapack.EVAll or
57// lapack.AllEVMulQ, mm must be at least n. If howmny is
58// lapack.EVSelected, mm must be large enough to store the selected
59// eigenvectors. Each selected real eigenvector occupies one column and each
60// selected complex eigenvector occupies two columns. If mm is not sufficiently
61// large, Dtrevc3 will panic.
62//
63// On entry, if howmny is lapack.EVAllMulQ, it is assumed that VL (if side
64// is lapack.EVLeft or lapack.EVBoth) contains an n×n matrix QL,
65// and that VR (if side is lapack.EVRight or lapack.EVBoth) contains
66// an n×n matrix QR. QL and QR are typically the orthogonal matrix Q of Schur
67// vectors returned by Dhseqr.
68//
69// On return, if side is lapack.EVLeft or lapack.EVBoth,
70// VL will contain:
71//  if howmny == lapack.EVAll,      the matrix Y of left eigenvectors of T,
72//  if howmny == lapack.EVAllMulQ,  the matrix Q*Y,
73//  if howmny == lapack.EVSelected, the left eigenvectors of T specified by
74//                                  selected, stored consecutively in the
75//                                  columns of VL, in the same order as their
76//                                  eigenvalues.
77// VL is not referenced if side == lapack.EVRight.
78//
79// On return, if side is lapack.EVRight or lapack.EVBoth,
80// VR will contain:
81//  if howmny == lapack.EVAll,      the matrix X of right eigenvectors of T,
82//  if howmny == lapack.EVAllMulQ,  the matrix Q*X,
83//  if howmny == lapack.EVSelected, the left eigenvectors of T specified by
84//                                  selected, stored consecutively in the
85//                                  columns of VR, in the same order as their
86//                                  eigenvalues.
87// VR is not referenced if side == lapack.EVLeft.
88//
89// Complex eigenvectors corresponding to a complex eigenvalue are stored in VL
90// and VR in two consecutive columns, the first holding the real part, and the
91// second the imaginary part.
92//
93// Each eigenvector will be normalized so that the element of largest magnitude
94// has magnitude 1. Here the magnitude of a complex number (x,y) is taken to be
95// |x| + |y|.
96//
97// work must have length at least lwork and lwork must be at least max(1,3*n),
98// otherwise Dtrevc3 will panic. For optimum performance, lwork should be at
99// least n+2*n*nb, where nb is the optimal blocksize.
100//
101// If lwork == -1, instead of performing Dtrevc3, the function only estimates
102// the optimal workspace size based on n and stores it into work[0].
103//
104// Dtrevc3 returns the number of columns in VL and/or VR actually used to store
105// the eigenvectors.
106//
107// Dtrevc3 is an internal routine. It is exported for testing purposes.
108func (impl Implementation) Dtrevc3(side lapack.EVSide, howmny lapack.EVHowMany, selected []bool, n int, t []float64, ldt int, vl []float64, ldvl int, vr []float64, ldvr int, mm int, work []float64, lwork int) (m int) {
109	bothv := side == lapack.EVBoth
110	rightv := side == lapack.EVRight || bothv
111	leftv := side == lapack.EVLeft || bothv
112	switch {
113	case !rightv && !leftv:
114		panic(badEVSide)
115	case howmny != lapack.EVAll && howmny != lapack.EVAllMulQ && howmny != lapack.EVSelected:
116		panic(badEVHowMany)
117	case n < 0:
118		panic(nLT0)
119	case ldt < max(1, n):
120		panic(badLdT)
121	case mm < 0:
122		panic(mmLT0)
123	case ldvl < 1:
124		// ldvl and ldvr are also checked below after the computation of
125		// m (number of columns of VL and VR) in case of howmny == EVSelected.
126		panic(badLdVL)
127	case ldvr < 1:
128		panic(badLdVR)
129	case lwork < max(1, 3*n) && lwork != -1:
130		panic(badLWork)
131	case len(work) < max(1, lwork):
132		panic(shortWork)
133	}
134
135	// Quick return if possible.
136	if n == 0 {
137		work[0] = 1
138		return 0
139	}
140
141	// Normally we don't check slice lengths until after the workspace
142	// query. However, even in case of the workspace query we need to
143	// compute and return the value of m, and since the computation accesses t,
144	// we put the length check of t here.
145	if len(t) < (n-1)*ldt+n {
146		panic(shortT)
147	}
148
149	if howmny == lapack.EVSelected {
150		if len(selected) != n {
151			panic(badLenSelected)
152		}
153		// Set m to the number of columns required to store the selected
154		// eigenvectors, and standardize the slice selected.
155		// Each selected real eigenvector occupies one column and each
156		// selected complex eigenvector occupies two columns.
157		for j := 0; j < n; {
158			if j == n-1 || t[(j+1)*ldt+j] == 0 {
159				// Diagonal 1×1 block corresponding to a
160				// real eigenvalue.
161				if selected[j] {
162					m++
163				}
164				j++
165			} else {
166				// Diagonal 2×2 block corresponding to a
167				// complex eigenvalue.
168				if selected[j] || selected[j+1] {
169					selected[j] = true
170					selected[j+1] = false
171					m += 2
172				}
173				j += 2
174			}
175		}
176	} else {
177		m = n
178	}
179	if mm < m {
180		panic(badMm)
181	}
182
183	// Quick return in case of a workspace query.
184	nb := impl.Ilaenv(1, "DTREVC", string(side)+string(howmny), n, -1, -1, -1)
185	if lwork == -1 {
186		work[0] = float64(n + 2*n*nb)
187		return m
188	}
189
190	// Quick return if no eigenvectors were selected.
191	if m == 0 {
192		return 0
193	}
194
195	switch {
196	case leftv && ldvl < mm:
197		panic(badLdVL)
198	case leftv && len(vl) < (n-1)*ldvl+mm:
199		panic(shortVL)
200
201	case rightv && ldvr < mm:
202		panic(badLdVR)
203	case rightv && len(vr) < (n-1)*ldvr+mm:
204		panic(shortVR)
205	}
206
207	// Use blocked version of back-transformation if sufficient workspace.
208	// Zero-out the workspace to avoid potential NaN propagation.
209	const (
210		nbmin = 8
211		nbmax = 128
212	)
213	if howmny == lapack.EVAllMulQ && lwork >= n+2*n*nbmin {
214		nb = min((lwork-n)/(2*n), nbmax)
215		impl.Dlaset(blas.All, n, 1+2*nb, 0, 0, work[:n+2*nb*n], 1+2*nb)
216	} else {
217		nb = 1
218	}
219
220	// Set the constants to control overflow.
221	ulp := dlamchP
222	smlnum := float64(n) / ulp * dlamchS
223	bignum := (1 - ulp) / smlnum
224
225	// Split work into a vector of column norms and an n×2*nb matrix b.
226	norms := work[:n]
227	ldb := 2 * nb
228	b := work[n : n+n*ldb]
229
230	// Compute 1-norm of each column of strictly upper triangular part of T
231	// to control overflow in triangular solver.
232	norms[0] = 0
233	for j := 1; j < n; j++ {
234		var cn float64
235		for i := 0; i < j; i++ {
236			cn += math.Abs(t[i*ldt+j])
237		}
238		norms[j] = cn
239	}
240
241	bi := blas64.Implementation()
242
243	var (
244		x [4]float64
245
246		iv int // Index of column in current block.
247		is int
248
249		// ip is used below to specify the real or complex eigenvalue:
250		//  ip == 0, real eigenvalue,
251		//        1, first  of conjugate complex pair (wr,wi),
252		//       -1, second of conjugate complex pair (wr,wi).
253		ip        int
254		iscomplex [nbmax]int // Stores ip for each column in current block.
255	)
256
257	if side == lapack.EVLeft {
258		goto leftev
259	}
260
261	// Compute right eigenvectors.
262
263	// For complex right vector, iv-1 is for real part and iv for complex
264	// part. Non-blocked version always uses iv=1, blocked version starts
265	// with iv=nb-1 and goes down to 0 or 1.
266	iv = max(2, nb) - 1
267	ip = 0
268	is = m - 1
269	for ki := n - 1; ki >= 0; ki-- {
270		if ip == -1 {
271			// Previous iteration (ki+1) was second of
272			// conjugate pair, so this ki is first of
273			// conjugate pair.
274			ip = 1
275			continue
276		}
277
278		if ki == 0 || t[ki*ldt+ki-1] == 0 {
279			// Last column or zero on sub-diagonal, so this
280			// ki must be real eigenvalue.
281			ip = 0
282		} else {
283			// Non-zero on sub-diagonal, so this ki is
284			// second of conjugate pair.
285			ip = -1
286		}
287
288		if howmny == lapack.EVSelected {
289			if ip == 0 {
290				if !selected[ki] {
291					continue
292				}
293			} else if !selected[ki-1] {
294				continue
295			}
296		}
297
298		// Compute the ki-th eigenvalue (wr,wi).
299		wr := t[ki*ldt+ki]
300		var wi float64
301		if ip != 0 {
302			wi = math.Sqrt(math.Abs(t[ki*ldt+ki-1])) * math.Sqrt(math.Abs(t[(ki-1)*ldt+ki]))
303		}
304		smin := math.Max(ulp*(math.Abs(wr)+math.Abs(wi)), smlnum)
305
306		if ip == 0 {
307			// Real right eigenvector.
308
309			b[ki*ldb+iv] = 1
310			// Form right-hand side.
311			for k := 0; k < ki; k++ {
312				b[k*ldb+iv] = -t[k*ldt+ki]
313			}
314			// Solve upper quasi-triangular system:
315			//  [ T[0:ki,0:ki] - wr ]*X = scale*b.
316			for j := ki - 1; j >= 0; {
317				if j == 0 || t[j*ldt+j-1] == 0 {
318					// 1×1 diagonal block.
319					scale, xnorm, _ := impl.Dlaln2(false, 1, 1, smin, 1, t[j*ldt+j:], ldt,
320						1, 1, b[j*ldb+iv:], ldb, wr, 0, x[:1], 2)
321					// Scale X[0,0] to avoid overflow when updating the
322					// right-hand side.
323					if xnorm > 1 && norms[j] > bignum/xnorm {
324						x[0] /= xnorm
325						scale /= xnorm
326					}
327					// Scale if necessary.
328					if scale != 1 {
329						bi.Dscal(ki+1, scale, b[iv:], ldb)
330					}
331					b[j*ldb+iv] = x[0]
332					// Update right-hand side.
333					bi.Daxpy(j, -x[0], t[j:], ldt, b[iv:], ldb)
334					j--
335				} else {
336					// 2×2 diagonal block.
337					scale, xnorm, _ := impl.Dlaln2(false, 2, 1, smin, 1, t[(j-1)*ldt+j-1:], ldt,
338						1, 1, b[(j-1)*ldb+iv:], ldb, wr, 0, x[:3], 2)
339					// Scale X[0,0] and X[1,0] to avoid overflow
340					// when updating the right-hand side.
341					if xnorm > 1 {
342						beta := math.Max(norms[j-1], norms[j])
343						if beta > bignum/xnorm {
344							x[0] /= xnorm
345							x[2] /= xnorm
346							scale /= xnorm
347						}
348					}
349					// Scale if necessary.
350					if scale != 1 {
351						bi.Dscal(ki+1, scale, b[iv:], ldb)
352					}
353					b[(j-1)*ldb+iv] = x[0]
354					b[j*ldb+iv] = x[2]
355					// Update right-hand side.
356					bi.Daxpy(j-1, -x[0], t[j-1:], ldt, b[iv:], ldb)
357					bi.Daxpy(j-1, -x[2], t[j:], ldt, b[iv:], ldb)
358					j -= 2
359				}
360			}
361			// Copy the vector x or Q*x to VR and normalize.
362			switch {
363			case howmny != lapack.EVAllMulQ:
364				// No back-transform: copy x to VR and normalize.
365				bi.Dcopy(ki+1, b[iv:], ldb, vr[is:], ldvr)
366				ii := bi.Idamax(ki+1, vr[is:], ldvr)
367				remax := 1 / math.Abs(vr[ii*ldvr+is])
368				bi.Dscal(ki+1, remax, vr[is:], ldvr)
369				for k := ki + 1; k < n; k++ {
370					vr[k*ldvr+is] = 0
371				}
372			case nb == 1:
373				// Version 1: back-transform each vector with GEMV, Q*x.
374				if ki > 0 {
375					bi.Dgemv(blas.NoTrans, n, ki, 1, vr, ldvr, b[iv:], ldb,
376						b[ki*ldb+iv], vr[ki:], ldvr)
377				}
378				ii := bi.Idamax(n, vr[ki:], ldvr)
379				remax := 1 / math.Abs(vr[ii*ldvr+ki])
380				bi.Dscal(n, remax, vr[ki:], ldvr)
381			default:
382				// Version 2: back-transform block of vectors with GEMM.
383				// Zero out below vector.
384				for k := ki + 1; k < n; k++ {
385					b[k*ldb+iv] = 0
386				}
387				iscomplex[iv] = ip
388				// Back-transform and normalization is done below.
389			}
390		} else {
391			// Complex right eigenvector.
392
393			// Initial solve
394			//  [ ( T[ki-1,ki-1] T[ki-1,ki] ) - (wr + i*wi) ]*X = 0.
395			//  [ ( T[ki,  ki-1] T[ki,  ki] )               ]
396			if math.Abs(t[(ki-1)*ldt+ki]) >= math.Abs(t[ki*ldt+ki-1]) {
397				b[(ki-1)*ldb+iv-1] = 1
398				b[ki*ldb+iv] = wi / t[(ki-1)*ldt+ki]
399			} else {
400				b[(ki-1)*ldb+iv-1] = -wi / t[ki*ldt+ki-1]
401				b[ki*ldb+iv] = 1
402			}
403			b[ki*ldb+iv-1] = 0
404			b[(ki-1)*ldb+iv] = 0
405			// Form right-hand side.
406			for k := 0; k < ki-1; k++ {
407				b[k*ldb+iv-1] = -b[(ki-1)*ldb+iv-1] * t[k*ldt+ki-1]
408				b[k*ldb+iv] = -b[ki*ldb+iv] * t[k*ldt+ki]
409			}
410			// Solve upper quasi-triangular system:
411			//  [ T[0:ki-1,0:ki-1] - (wr+i*wi) ]*X = scale*(b1+i*b2)
412			for j := ki - 2; j >= 0; {
413				if j == 0 || t[j*ldt+j-1] == 0 {
414					// 1×1 diagonal block.
415
416					scale, xnorm, _ := impl.Dlaln2(false, 1, 2, smin, 1, t[j*ldt+j:], ldt,
417						1, 1, b[j*ldb+iv-1:], ldb, wr, wi, x[:2], 2)
418					// Scale X[0,0] and X[0,1] to avoid
419					// overflow when updating the right-hand side.
420					if xnorm > 1 && norms[j] > bignum/xnorm {
421						x[0] /= xnorm
422						x[1] /= xnorm
423						scale /= xnorm
424					}
425					// Scale if necessary.
426					if scale != 1 {
427						bi.Dscal(ki+1, scale, b[iv-1:], ldb)
428						bi.Dscal(ki+1, scale, b[iv:], ldb)
429					}
430					b[j*ldb+iv-1] = x[0]
431					b[j*ldb+iv] = x[1]
432					// Update the right-hand side.
433					bi.Daxpy(j, -x[0], t[j:], ldt, b[iv-1:], ldb)
434					bi.Daxpy(j, -x[1], t[j:], ldt, b[iv:], ldb)
435					j--
436				} else {
437					// 2×2 diagonal block.
438
439					scale, xnorm, _ := impl.Dlaln2(false, 2, 2, smin, 1, t[(j-1)*ldt+j-1:], ldt,
440						1, 1, b[(j-1)*ldb+iv-1:], ldb, wr, wi, x[:], 2)
441					// Scale X to avoid overflow when updating
442					// the right-hand side.
443					if xnorm > 1 {
444						beta := math.Max(norms[j-1], norms[j])
445						if beta > bignum/xnorm {
446							rec := 1 / xnorm
447							x[0] *= rec
448							x[1] *= rec
449							x[2] *= rec
450							x[3] *= rec
451							scale *= rec
452						}
453					}
454					// Scale if necessary.
455					if scale != 1 {
456						bi.Dscal(ki+1, scale, b[iv-1:], ldb)
457						bi.Dscal(ki+1, scale, b[iv:], ldb)
458					}
459					b[(j-1)*ldb+iv-1] = x[0]
460					b[(j-1)*ldb+iv] = x[1]
461					b[j*ldb+iv-1] = x[2]
462					b[j*ldb+iv] = x[3]
463					// Update the right-hand side.
464					bi.Daxpy(j-1, -x[0], t[j-1:], ldt, b[iv-1:], ldb)
465					bi.Daxpy(j-1, -x[1], t[j-1:], ldt, b[iv:], ldb)
466					bi.Daxpy(j-1, -x[2], t[j:], ldt, b[iv-1:], ldb)
467					bi.Daxpy(j-1, -x[3], t[j:], ldt, b[iv:], ldb)
468					j -= 2
469				}
470			}
471
472			// Copy the vector x or Q*x to VR and normalize.
473			switch {
474			case howmny != lapack.EVAllMulQ:
475				// No back-transform: copy x to VR and normalize.
476				bi.Dcopy(ki+1, b[iv-1:], ldb, vr[is-1:], ldvr)
477				bi.Dcopy(ki+1, b[iv:], ldb, vr[is:], ldvr)
478				emax := 0.0
479				for k := 0; k <= ki; k++ {
480					emax = math.Max(emax, math.Abs(vr[k*ldvr+is-1])+math.Abs(vr[k*ldvr+is]))
481				}
482				remax := 1 / emax
483				bi.Dscal(ki+1, remax, vr[is-1:], ldvr)
484				bi.Dscal(ki+1, remax, vr[is:], ldvr)
485				for k := ki + 1; k < n; k++ {
486					vr[k*ldvr+is-1] = 0
487					vr[k*ldvr+is] = 0
488				}
489			case nb == 1:
490				// Version 1: back-transform each vector with GEMV, Q*x.
491				if ki-1 > 0 {
492					bi.Dgemv(blas.NoTrans, n, ki-1, 1, vr, ldvr, b[iv-1:], ldb,
493						b[(ki-1)*ldb+iv-1], vr[ki-1:], ldvr)
494					bi.Dgemv(blas.NoTrans, n, ki-1, 1, vr, ldvr, b[iv:], ldb,
495						b[ki*ldb+iv], vr[ki:], ldvr)
496				} else {
497					bi.Dscal(n, b[(ki-1)*ldb+iv-1], vr[ki-1:], ldvr)
498					bi.Dscal(n, b[ki*ldb+iv], vr[ki:], ldvr)
499				}
500				emax := 0.0
501				for k := 0; k < n; k++ {
502					emax = math.Max(emax, math.Abs(vr[k*ldvr+ki-1])+math.Abs(vr[k*ldvr+ki]))
503				}
504				remax := 1 / emax
505				bi.Dscal(n, remax, vr[ki-1:], ldvr)
506				bi.Dscal(n, remax, vr[ki:], ldvr)
507			default:
508				// Version 2: back-transform block of vectors with GEMM.
509				// Zero out below vector.
510				for k := ki + 1; k < n; k++ {
511					b[k*ldb+iv-1] = 0
512					b[k*ldb+iv] = 0
513				}
514				iscomplex[iv-1] = -ip
515				iscomplex[iv] = ip
516				iv--
517				// Back-transform and normalization is done below.
518			}
519		}
520		if nb > 1 {
521			// Blocked version of back-transform.
522
523			// For complex case, ki2 includes both vectors (ki-1 and ki).
524			ki2 := ki
525			if ip != 0 {
526				ki2--
527			}
528			// Columns iv:nb of b are valid vectors.
529			// When the number of vectors stored reaches nb-1 or nb,
530			// or if this was last vector, do the Gemm.
531			if iv < 2 || ki2 == 0 {
532				bi.Dgemm(blas.NoTrans, blas.NoTrans, n, nb-iv, ki2+nb-iv,
533					1, vr, ldvr, b[iv:], ldb,
534					0, b[nb+iv:], ldb)
535				// Normalize vectors.
536				var remax float64
537				for k := iv; k < nb; k++ {
538					if iscomplex[k] == 0 {
539						// Real eigenvector.
540						ii := bi.Idamax(n, b[nb+k:], ldb)
541						remax = 1 / math.Abs(b[ii*ldb+nb+k])
542					} else if iscomplex[k] == 1 {
543						// First eigenvector of conjugate pair.
544						emax := 0.0
545						for ii := 0; ii < n; ii++ {
546							emax = math.Max(emax, math.Abs(b[ii*ldb+nb+k])+math.Abs(b[ii*ldb+nb+k+1]))
547						}
548						remax = 1 / emax
549						// Second eigenvector of conjugate pair
550						// will reuse this value of remax.
551					}
552					bi.Dscal(n, remax, b[nb+k:], ldb)
553				}
554				impl.Dlacpy(blas.All, n, nb-iv, b[nb+iv:], ldb, vr[ki2:], ldvr)
555				iv = nb - 1
556			} else {
557				iv--
558			}
559		}
560		is--
561		if ip != 0 {
562			is--
563		}
564	}
565
566	if side == lapack.EVRight {
567		return m
568	}
569
570leftev:
571	// Compute left eigenvectors.
572
573	// For complex left vector, iv is for real part and iv+1 for complex
574	// part. Non-blocked version always uses iv=0. Blocked version starts
575	// with iv=0, goes up to nb-2 or nb-1.
576	iv = 0
577	ip = 0
578	is = 0
579	for ki := 0; ki < n; ki++ {
580		if ip == 1 {
581			// Previous iteration ki-1 was first of conjugate pair,
582			// so this ki is second of conjugate pair.
583			ip = -1
584			continue
585		}
586
587		if ki == n-1 || t[(ki+1)*ldt+ki] == 0 {
588			// Last column or zero on sub-diagonal, so this ki must
589			// be real eigenvalue.
590			ip = 0
591		} else {
592			// Non-zero on sub-diagonal, so this ki is first of
593			// conjugate pair.
594			ip = 1
595		}
596		if howmny == lapack.EVSelected && !selected[ki] {
597			continue
598		}
599
600		// Compute the ki-th eigenvalue (wr,wi).
601		wr := t[ki*ldt+ki]
602		var wi float64
603		if ip != 0 {
604			wi = math.Sqrt(math.Abs(t[ki*ldt+ki+1])) * math.Sqrt(math.Abs(t[(ki+1)*ldt+ki]))
605		}
606		smin := math.Max(ulp*(math.Abs(wr)+math.Abs(wi)), smlnum)
607
608		if ip == 0 {
609			// Real left eigenvector.
610
611			b[ki*ldb+iv] = 1
612			// Form right-hand side.
613			for k := ki + 1; k < n; k++ {
614				b[k*ldb+iv] = -t[ki*ldt+k]
615			}
616			// Solve transposed quasi-triangular system:
617			//  [ T[ki+1:n,ki+1:n] - wr ]ᵀ * X = scale*b
618			vmax := 1.0
619			vcrit := bignum
620			for j := ki + 1; j < n; {
621				if j == n-1 || t[(j+1)*ldt+j] == 0 {
622					// 1×1 diagonal block.
623
624					// Scale if necessary to avoid overflow
625					// when forming the right-hand side.
626					if norms[j] > vcrit {
627						rec := 1 / vmax
628						bi.Dscal(n-ki, rec, b[ki*ldb+iv:], ldb)
629						vmax = 1
630					}
631					b[j*ldb+iv] -= bi.Ddot(j-ki-1, t[(ki+1)*ldt+j:], ldt, b[(ki+1)*ldb+iv:], ldb)
632					// Solve [ T[j,j] - wr ]ᵀ * X = b.
633					scale, _, _ := impl.Dlaln2(false, 1, 1, smin, 1, t[j*ldt+j:], ldt,
634						1, 1, b[j*ldb+iv:], ldb, wr, 0, x[:1], 2)
635					// Scale if necessary.
636					if scale != 1 {
637						bi.Dscal(n-ki, scale, b[ki*ldb+iv:], ldb)
638					}
639					b[j*ldb+iv] = x[0]
640					vmax = math.Max(math.Abs(b[j*ldb+iv]), vmax)
641					vcrit = bignum / vmax
642					j++
643				} else {
644					// 2×2 diagonal block.
645
646					// Scale if necessary to avoid overflow
647					// when forming the right-hand side.
648					beta := math.Max(norms[j], norms[j+1])
649					if beta > vcrit {
650						bi.Dscal(n-ki, 1/vmax, b[ki*ldb+iv:], ldb)
651						vmax = 1
652					}
653					b[j*ldb+iv] -= bi.Ddot(j-ki-1, t[(ki+1)*ldt+j:], ldt, b[(ki+1)*ldb+iv:], ldb)
654					b[(j+1)*ldb+iv] -= bi.Ddot(j-ki-1, t[(ki+1)*ldt+j+1:], ldt, b[(ki+1)*ldb+iv:], ldb)
655					// Solve
656					//  [ T[j,j]-wr  T[j,j+1]      ]ᵀ * X = scale*[ b1 ]
657					//  [ T[j+1,j]   T[j+1,j+1]-wr ]              [ b2 ]
658					scale, _, _ := impl.Dlaln2(true, 2, 1, smin, 1, t[j*ldt+j:], ldt,
659						1, 1, b[j*ldb+iv:], ldb, wr, 0, x[:3], 2)
660					// Scale if necessary.
661					if scale != 1 {
662						bi.Dscal(n-ki, scale, b[ki*ldb+iv:], ldb)
663					}
664					b[j*ldb+iv] = x[0]
665					b[(j+1)*ldb+iv] = x[2]
666					vmax = math.Max(vmax, math.Max(math.Abs(b[j*ldb+iv]), math.Abs(b[(j+1)*ldb+iv])))
667					vcrit = bignum / vmax
668					j += 2
669				}
670			}
671			// Copy the vector x or Q*x to VL and normalize.
672			switch {
673			case howmny != lapack.EVAllMulQ:
674				// No back-transform: copy x to VL and normalize.
675				bi.Dcopy(n-ki, b[ki*ldb+iv:], ldb, vl[ki*ldvl+is:], ldvl)
676				ii := bi.Idamax(n-ki, vl[ki*ldvl+is:], ldvl) + ki
677				remax := 1 / math.Abs(vl[ii*ldvl+is])
678				bi.Dscal(n-ki, remax, vl[ki*ldvl+is:], ldvl)
679				for k := 0; k < ki; k++ {
680					vl[k*ldvl+is] = 0
681				}
682			case nb == 1:
683				// Version 1: back-transform each vector with Gemv, Q*x.
684				if n-ki-1 > 0 {
685					bi.Dgemv(blas.NoTrans, n, n-ki-1,
686						1, vl[ki+1:], ldvl, b[(ki+1)*ldb+iv:], ldb,
687						b[ki*ldb+iv], vl[ki:], ldvl)
688				}
689				ii := bi.Idamax(n, vl[ki:], ldvl)
690				remax := 1 / math.Abs(vl[ii*ldvl+ki])
691				bi.Dscal(n, remax, vl[ki:], ldvl)
692			default:
693				// Version 2: back-transform block of vectors with Gemm
694				// zero out above vector.
695				for k := 0; k < ki; k++ {
696					b[k*ldb+iv] = 0
697				}
698				iscomplex[iv] = ip
699				// Back-transform and normalization is done below.
700			}
701		} else {
702			// Complex left eigenvector.
703
704			// Initial solve:
705			// [ [ T[ki,ki]   T[ki,ki+1]   ]ᵀ - (wr - i* wi) ]*X = 0.
706			// [ [ T[ki+1,ki] T[ki+1,ki+1] ]                 ]
707			if math.Abs(t[ki*ldt+ki+1]) >= math.Abs(t[(ki+1)*ldt+ki]) {
708				b[ki*ldb+iv] = wi / t[ki*ldt+ki+1]
709				b[(ki+1)*ldb+iv+1] = 1
710			} else {
711				b[ki*ldb+iv] = 1
712				b[(ki+1)*ldb+iv+1] = -wi / t[(ki+1)*ldt+ki]
713			}
714			b[(ki+1)*ldb+iv] = 0
715			b[ki*ldb+iv+1] = 0
716			// Form right-hand side.
717			for k := ki + 2; k < n; k++ {
718				b[k*ldb+iv] = -b[ki*ldb+iv] * t[ki*ldt+k]
719				b[k*ldb+iv+1] = -b[(ki+1)*ldb+iv+1] * t[(ki+1)*ldt+k]
720			}
721			// Solve transposed quasi-triangular system:
722			// [ T[ki+2:n,ki+2:n]ᵀ - (wr-i*wi) ]*X = b1+i*b2
723			vmax := 1.0
724			vcrit := bignum
725			for j := ki + 2; j < n; {
726				if j == n-1 || t[(j+1)*ldt+j] == 0 {
727					// 1×1 diagonal block.
728
729					// Scale if necessary to avoid overflow
730					// when forming the right-hand side elements.
731					if norms[j] > vcrit {
732						rec := 1 / vmax
733						bi.Dscal(n-ki, rec, b[ki*ldb+iv:], ldb)
734						bi.Dscal(n-ki, rec, b[ki*ldb+iv+1:], ldb)
735						vmax = 1
736					}
737					b[j*ldb+iv] -= bi.Ddot(j-ki-2, t[(ki+2)*ldt+j:], ldt, b[(ki+2)*ldb+iv:], ldb)
738					b[j*ldb+iv+1] -= bi.Ddot(j-ki-2, t[(ki+2)*ldt+j:], ldt, b[(ki+2)*ldb+iv+1:], ldb)
739					// Solve [ T[j,j]-(wr-i*wi) ]*(X11+i*X12) = b1+i*b2.
740					scale, _, _ := impl.Dlaln2(false, 1, 2, smin, 1, t[j*ldt+j:], ldt,
741						1, 1, b[j*ldb+iv:], ldb, wr, -wi, x[:2], 2)
742					// Scale if necessary.
743					if scale != 1 {
744						bi.Dscal(n-ki, scale, b[ki*ldb+iv:], ldb)
745						bi.Dscal(n-ki, scale, b[ki*ldb+iv+1:], ldb)
746					}
747					b[j*ldb+iv] = x[0]
748					b[j*ldb+iv+1] = x[1]
749					vmax = math.Max(vmax, math.Max(math.Abs(b[j*ldb+iv]), math.Abs(b[j*ldb+iv+1])))
750					vcrit = bignum / vmax
751					j++
752				} else {
753					// 2×2 diagonal block.
754
755					// Scale if necessary to avoid overflow
756					// when forming the right-hand side elements.
757					if math.Max(norms[j], norms[j+1]) > vcrit {
758						rec := 1 / vmax
759						bi.Dscal(n-ki, rec, b[ki*ldb+iv:], ldb)
760						bi.Dscal(n-ki, rec, b[ki*ldb+iv+1:], ldb)
761						vmax = 1
762					}
763					b[j*ldb+iv] -= bi.Ddot(j-ki-2, t[(ki+2)*ldt+j:], ldt, b[(ki+2)*ldb+iv:], ldb)
764					b[j*ldb+iv+1] -= bi.Ddot(j-ki-2, t[(ki+2)*ldt+j:], ldt, b[(ki+2)*ldb+iv+1:], ldb)
765					b[(j+1)*ldb+iv] -= bi.Ddot(j-ki-2, t[(ki+2)*ldt+j+1:], ldt, b[(ki+2)*ldb+iv:], ldb)
766					b[(j+1)*ldb+iv+1] -= bi.Ddot(j-ki-2, t[(ki+2)*ldt+j+1:], ldt, b[(ki+2)*ldb+iv+1:], ldb)
767					// Solve 2×2 complex linear equation
768					//  [ [T[j,j]   T[j,j+1]  ]ᵀ - (wr-i*wi)*I ]*X = scale*b
769					//  [ [T[j+1,j] T[j+1,j+1]]                ]
770					scale, _, _ := impl.Dlaln2(true, 2, 2, smin, 1, t[j*ldt+j:], ldt,
771						1, 1, b[j*ldb+iv:], ldb, wr, -wi, x[:], 2)
772					// Scale if necessary.
773					if scale != 1 {
774						bi.Dscal(n-ki, scale, b[ki*ldb+iv:], ldb)
775						bi.Dscal(n-ki, scale, b[ki*ldb+iv+1:], ldb)
776					}
777					b[j*ldb+iv] = x[0]
778					b[j*ldb+iv+1] = x[1]
779					b[(j+1)*ldb+iv] = x[2]
780					b[(j+1)*ldb+iv+1] = x[3]
781					vmax01 := math.Max(math.Abs(x[0]), math.Abs(x[1]))
782					vmax23 := math.Max(math.Abs(x[2]), math.Abs(x[3]))
783					vmax = math.Max(vmax, math.Max(vmax01, vmax23))
784					vcrit = bignum / vmax
785					j += 2
786				}
787			}
788			// Copy the vector x or Q*x to VL and normalize.
789			switch {
790			case howmny != lapack.EVAllMulQ:
791				// No back-transform: copy x to VL and normalize.
792				bi.Dcopy(n-ki, b[ki*ldb+iv:], ldb, vl[ki*ldvl+is:], ldvl)
793				bi.Dcopy(n-ki, b[ki*ldb+iv+1:], ldb, vl[ki*ldvl+is+1:], ldvl)
794				emax := 0.0
795				for k := ki; k < n; k++ {
796					emax = math.Max(emax, math.Abs(vl[k*ldvl+is])+math.Abs(vl[k*ldvl+is+1]))
797				}
798				remax := 1 / emax
799				bi.Dscal(n-ki, remax, vl[ki*ldvl+is:], ldvl)
800				bi.Dscal(n-ki, remax, vl[ki*ldvl+is+1:], ldvl)
801				for k := 0; k < ki; k++ {
802					vl[k*ldvl+is] = 0
803					vl[k*ldvl+is+1] = 0
804				}
805			case nb == 1:
806				// Version 1: back-transform each vector with GEMV, Q*x.
807				if n-ki-2 > 0 {
808					bi.Dgemv(blas.NoTrans, n, n-ki-2,
809						1, vl[ki+2:], ldvl, b[(ki+2)*ldb+iv:], ldb,
810						b[ki*ldb+iv], vl[ki:], ldvl)
811					bi.Dgemv(blas.NoTrans, n, n-ki-2,
812						1, vl[ki+2:], ldvl, b[(ki+2)*ldb+iv+1:], ldb,
813						b[(ki+1)*ldb+iv+1], vl[ki+1:], ldvl)
814				} else {
815					bi.Dscal(n, b[ki*ldb+iv], vl[ki:], ldvl)
816					bi.Dscal(n, b[(ki+1)*ldb+iv+1], vl[ki+1:], ldvl)
817				}
818				emax := 0.0
819				for k := 0; k < n; k++ {
820					emax = math.Max(emax, math.Abs(vl[k*ldvl+ki])+math.Abs(vl[k*ldvl+ki+1]))
821				}
822				remax := 1 / emax
823				bi.Dscal(n, remax, vl[ki:], ldvl)
824				bi.Dscal(n, remax, vl[ki+1:], ldvl)
825			default:
826				// Version 2: back-transform block of vectors with GEMM.
827				// Zero out above vector.
828				// Could go from ki-nv+1 to ki-1.
829				for k := 0; k < ki; k++ {
830					b[k*ldb+iv] = 0
831					b[k*ldb+iv+1] = 0
832				}
833				iscomplex[iv] = ip
834				iscomplex[iv+1] = -ip
835				iv++
836				// Back-transform and normalization is done below.
837			}
838		}
839		if nb > 1 {
840			// Blocked version of back-transform.
841			// For complex case, ki2 includes both vectors ki and ki+1.
842			ki2 := ki
843			if ip != 0 {
844				ki2++
845			}
846			// Columns [0:iv] of work are valid vectors. When the
847			// number of vectors stored reaches nb-1 or nb, or if
848			// this was last vector, do the Gemm.
849			if iv >= nb-2 || ki2 == n-1 {
850				bi.Dgemm(blas.NoTrans, blas.NoTrans, n, iv+1, n-ki2+iv,
851					1, vl[ki2-iv:], ldvl, b[(ki2-iv)*ldb:], ldb,
852					0, b[nb:], ldb)
853				// Normalize vectors.
854				var remax float64
855				for k := 0; k <= iv; k++ {
856					if iscomplex[k] == 0 {
857						// Real eigenvector.
858						ii := bi.Idamax(n, b[nb+k:], ldb)
859						remax = 1 / math.Abs(b[ii*ldb+nb+k])
860					} else if iscomplex[k] == 1 {
861						// First eigenvector of conjugate pair.
862						emax := 0.0
863						for ii := 0; ii < n; ii++ {
864							emax = math.Max(emax, math.Abs(b[ii*ldb+nb+k])+math.Abs(b[ii*ldb+nb+k+1]))
865						}
866						remax = 1 / emax
867						// Second eigenvector of conjugate pair
868						// will reuse this value of remax.
869					}
870					bi.Dscal(n, remax, b[nb+k:], ldb)
871				}
872				impl.Dlacpy(blas.All, n, iv+1, b[nb:], ldb, vl[ki2-iv:], ldvl)
873				iv = 0
874			} else {
875				iv++
876			}
877		}
878		is++
879		if ip != 0 {
880			is++
881		}
882	}
883
884	return m
885}
886