1: #region Translated by Jose Antonio De Santiago-Castillo.
2:
3: //Translated by Jose Antonio De Santiago-Castillo.
4: //E-mail:JAntonioDeSantiago@gmail.com
5: //Web: www.DotNumerics.com
6: //
7: //Fortran to C# Translation.
8: //Translated by:
9: //F2CSharp Version 0.71 (November 10, 2009)
10: //Code Optimizations: None
11: //
12: #endregion
13:
14: using System;
15: using DotNumerics.FortranLibrary;
16:
17: namespace DotNumerics.CSLapack
18: {
19: /// <summary>
20: /// -- LAPACK auxiliary routine (version 3.1) --
21: /// Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
22: /// November 2006
23: /// Purpose
24: /// =======
25: ///
26: /// DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
27: /// an upper quasi-triangular matrix T by an orthogonal similarity
28: /// transformation.
29: ///
30: /// T must be in Schur canonical form, that is, block upper triangular
31: /// with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
32: /// has its diagonal elemnts equal and its off-diagonal elements of
33: /// opposite sign.
34: ///
35: ///</summary>
36: public class DLAEXC
37: {
38:
39:
40: #region Dependencies
41:
42: DLAMCH _dlamch; DLANGE _dlange; DLACPY _dlacpy; DLANV2 _dlanv2; DLARFG _dlarfg; DLARFX _dlarfx; DLARTG _dlartg;
43: DLASY2 _dlasy2;DROT _drot;
44:
45: #endregion
46:
47:
48: #region Fields
49:
50: const double ZERO = 0.0E+0; const double ONE = 1.0E+0; const double TEN = 1.0E+1; const int LDD = 4; const int LDX = 2;
51: int IERR = 0;int J2 = 0; int J3 = 0; int J4 = 0; int K = 0; int ND = 0; double CS = 0; double DNORM = 0; double EPS = 0;
52: double SCALE = 0;double SMLNUM = 0; double SN = 0; double T11 = 0; double T22 = 0; double T33 = 0; double TAU = 0;
53: double TAU1 = 0;double TAU2 = 0; double TEMP = 0; double THRESH = 0; double WI1 = 0; double WI2 = 0; double WR1 = 0;
54: double WR2 = 0;double XNORM = 0; double[] D = new double[LDD * 4]; int offset_d = 0; int o_d = -1 - LDD;
55: double[] U = new double[3]; int offset_u = 0; int o_u = -1;double[] U1 = new double[3]; int offset_u1 = 0; int o_u1 = -1;
56: double[] U2 = new double[3]; int offset_u2 = 0; int o_u2 = -1;double[] X = new double[LDX * 2]; int offset_x = 0; int o_x = -1 - LDX;
57:
58: #endregion
59:
60: public DLAEXC(DLAMCH dlamch, DLANGE dlange, DLACPY dlacpy, DLANV2 dlanv2, DLARFG dlarfg, DLARFX dlarfx, DLARTG dlartg, DLASY2 dlasy2, DROT drot)
61: {
62:
63:
64: #region Set Dependencies
65:
66: this._dlamch = dlamch; this._dlange = dlange; this._dlacpy = dlacpy; this._dlanv2 = dlanv2; this._dlarfg = dlarfg;
67: this._dlarfx = dlarfx;this._dlartg = dlartg; this._dlasy2 = dlasy2; this._drot = drot;
68:
69: #endregion
70:
71: }
72:
73: public DLAEXC()
74: {
75:
76:
77: #region Dependencies (Initialization)
78:
79: LSAME lsame = new LSAME();
80: DLAMC3 dlamc3 = new DLAMC3();
81: DLASSQ dlassq = new DLASSQ();
82: DLAPY2 dlapy2 = new DLAPY2();
83: DNRM2 dnrm2 = new DNRM2();
84: DSCAL dscal = new DSCAL();
85: XERBLA xerbla = new XERBLA();
86: IDAMAX idamax = new IDAMAX();
87: DCOPY dcopy = new DCOPY();
88: DSWAP dswap = new DSWAP();
89: DROT drot = new DROT();
90: DLAMC1 dlamc1 = new DLAMC1(dlamc3);
91: DLAMC4 dlamc4 = new DLAMC4(dlamc3);
92: DLAMC5 dlamc5 = new DLAMC5(dlamc3);
93: DLAMC2 dlamc2 = new DLAMC2(dlamc3, dlamc1, dlamc4, dlamc5);
94: DLAMCH dlamch = new DLAMCH(lsame, dlamc2);
95: DLANGE dlange = new DLANGE(dlassq, lsame);
96: DLACPY dlacpy = new DLACPY(lsame);
97: DLANV2 dlanv2 = new DLANV2(dlamch, dlapy2);
98: DLARFG dlarfg = new DLARFG(dlamch, dlapy2, dnrm2, dscal);
99: DGEMV dgemv = new DGEMV(lsame, xerbla);
100: DGER dger = new DGER(xerbla);
101: DLARFX dlarfx = new DLARFX(lsame, dgemv, dger);
102: DLARTG dlartg = new DLARTG(dlamch);
103: DLASY2 dlasy2 = new DLASY2(idamax, dlamch, dcopy, dswap);
104:
105: #endregion
106:
107:
108: #region Set Dependencies
109:
110: this._dlamch = dlamch; this._dlange = dlange; this._dlacpy = dlacpy; this._dlanv2 = dlanv2; this._dlarfg = dlarfg;
111: this._dlarfx = dlarfx;this._dlartg = dlartg; this._dlasy2 = dlasy2; this._drot = drot;
112:
113: #endregion
114:
115: }
116: /// <summary>
117: /// Purpose
118: /// =======
119: ///
120: /// DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
121: /// an upper quasi-triangular matrix T by an orthogonal similarity
122: /// transformation.
123: ///
124: /// T must be in Schur canonical form, that is, block upper triangular
125: /// with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
126: /// has its diagonal elemnts equal and its off-diagonal elements of
127: /// opposite sign.
128: ///
129: ///</summary>
130: /// <param name="WANTQ">
131: /// (input) LOGICAL
132: /// = .TRUE. : accumulate the transformation in the matrix Q;
133: /// = .FALSE.: do not accumulate the transformation.
134: ///</param>
135: /// <param name="N">
136: /// (input) INTEGER
137: /// The order of the matrix T. N .GE. 0.
138: ///</param>
139: /// <param name="T">
140: /// must be in Schur canonical form, that is, block upper triangular
141: ///</param>
142: /// <param name="LDT">
143: /// (input) INTEGER
144: /// The leading dimension of the array T. LDT .GE. max(1,N).
145: ///</param>
146: /// <param name="Q">
147: /// (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
148: /// On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
149: /// On exit, if WANTQ is .TRUE., the updated matrix Q.
150: /// If WANTQ is .FALSE., Q is not referenced.
151: ///</param>
152: /// <param name="LDQ">
153: /// (input) INTEGER
154: /// The leading dimension of the array Q.
155: /// LDQ .GE. 1; and if WANTQ is .TRUE., LDQ .GE. N.
156: ///</param>
157: /// <param name="J1">
158: /// (input) INTEGER
159: /// The index of the first row of the first block T11.
160: ///</param>
161: /// <param name="N1">
162: /// (input) INTEGER
163: /// The order of the first block T11. N1 = 0, 1 or 2.
164: ///</param>
165: /// <param name="N2">
166: /// (input) INTEGER
167: /// The order of the second block T22. N2 = 0, 1 or 2.
168: ///</param>
169: /// <param name="WORK">
170: /// (workspace) DOUBLE PRECISION array, dimension (N)
171: ///</param>
172: /// <param name="INFO">
173: /// (output) INTEGER
174: /// = 0: successful exit
175: /// = 1: the transformed matrix T would be too far from Schur
176: /// form; the blocks are not swapped and T and Q are
177: /// unchanged.
178: ///</param>
179: public void Run(bool WANTQ, int N, ref double[] T, int offset_t, int LDT, ref double[] Q, int offset_q, int LDQ
180: , int J1, int N1, int N2, ref double[] WORK, int offset_work, ref int INFO)
181: {
182:
183: #region Array Index Correction
184:
185: int o_t = -1 - LDT + offset_t; int o_q = -1 - LDQ + offset_q; int o_work = -1 + offset_work;
186:
187: #endregion
188:
189:
190: #region Prolog
191:
192: // *
193: // * -- LAPACK auxiliary routine (version 3.1) --
194: // * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
195: // * November 2006
196: // *
197: // * .. Scalar Arguments ..
198: // * ..
199: // * .. Array Arguments ..
200: // * ..
201: // *
202: // * Purpose
203: // * =======
204: // *
205: // * DLAEXC swaps adjacent diagonal blocks T11 and T22 of order 1 or 2 in
206: // * an upper quasi-triangular matrix T by an orthogonal similarity
207: // * transformation.
208: // *
209: // * T must be in Schur canonical form, that is, block upper triangular
210: // * with 1-by-1 and 2-by-2 diagonal blocks; each 2-by-2 diagonal block
211: // * has its diagonal elemnts equal and its off-diagonal elements of
212: // * opposite sign.
213: // *
214: // * Arguments
215: // * =========
216: // *
217: // * WANTQ (input) LOGICAL
218: // * = .TRUE. : accumulate the transformation in the matrix Q;
219: // * = .FALSE.: do not accumulate the transformation.
220: // *
221: // * N (input) INTEGER
222: // * The order of the matrix T. N >= 0.
223: // *
224: // * T (input/output) DOUBLE PRECISION array, dimension (LDT,N)
225: // * On entry, the upper quasi-triangular matrix T, in Schur
226: // * canonical form.
227: // * On exit, the updated matrix T, again in Schur canonical form.
228: // *
229: // * LDT (input) INTEGER
230: // * The leading dimension of the array T. LDT >= max(1,N).
231: // *
232: // * Q (input/output) DOUBLE PRECISION array, dimension (LDQ,N)
233: // * On entry, if WANTQ is .TRUE., the orthogonal matrix Q.
234: // * On exit, if WANTQ is .TRUE., the updated matrix Q.
235: // * If WANTQ is .FALSE., Q is not referenced.
236: // *
237: // * LDQ (input) INTEGER
238: // * The leading dimension of the array Q.
239: // * LDQ >= 1; and if WANTQ is .TRUE., LDQ >= N.
240: // *
241: // * J1 (input) INTEGER
242: // * The index of the first row of the first block T11.
243: // *
244: // * N1 (input) INTEGER
245: // * The order of the first block T11. N1 = 0, 1 or 2.
246: // *
247: // * N2 (input) INTEGER
248: // * The order of the second block T22. N2 = 0, 1 or 2.
249: // *
250: // * WORK (workspace) DOUBLE PRECISION array, dimension (N)
251: // *
252: // * INFO (output) INTEGER
253: // * = 0: successful exit
254: // * = 1: the transformed matrix T would be too far from Schur
255: // * form; the blocks are not swapped and T and Q are
256: // * unchanged.
257: // *
258: // * =====================================================================
259: // *
260: // * .. Parameters ..
261: // * ..
262: // * .. Local Scalars ..
263: // * ..
264: // * .. Local Arrays ..
265: // * ..
266: // * .. External Functions ..
267: // * ..
268: // * .. External Subroutines ..
269: // * ..
270: // * .. Intrinsic Functions ..
271: // INTRINSIC ABS, MAX;
272: // * ..
273: // * .. Executable Statements ..
274: // *
275:
276: #endregion
277:
278:
279: #region Body
280:
281: INFO = 0;
282: // *
283: // * Quick return if possible
284: // *
285: if (N == 0 || N1 == 0 || N2 == 0) return;
286: if (J1 + N1 > N) return;
287: // *
288: J2 = J1 + 1;
289: J3 = J1 + 2;
290: J4 = J1 + 3;
291: // *
292: if (N1 == 1 && N2 == 1)
293: {
294: // *
295: // * Swap two 1-by-1 blocks.
296: // *
297: T11 = T[J1+J1 * LDT + o_t];
298: T22 = T[J2+J2 * LDT + o_t];
299: // *
300: // * Determine the transformation to perform the interchange.
301: // *
302: this._dlartg.Run(T[J1+J2 * LDT + o_t], T22 - T11, ref CS, ref SN, ref TEMP);
303: // *
304: // * Apply transformation to the matrix T.
305: // *
306: if (J3 <= N)
307: {
308: this._drot.Run(N - J1 - 1, ref T, J1+J3 * LDT + o_t, LDT, ref T, J2+J3 * LDT + o_t, LDT, CS
309: , SN);
310: }
311: this._drot.Run(J1 - 1, ref T, 1+J1 * LDT + o_t, 1, ref T, 1+J2 * LDT + o_t, 1, CS
312: , SN);
313: // *
314: T[J1+J1 * LDT + o_t] = T22;
315: T[J2+J2 * LDT + o_t] = T11;
316: // *
317: if (WANTQ)
318: {
319: // *
320: // * Accumulate transformation in the matrix Q.
321: // *
322: this._drot.Run(N, ref Q, 1+J1 * LDQ + o_q, 1, ref Q, 1+J2 * LDQ + o_q, 1, CS
323: , SN);
324: }
325: // *
326: }
327: else
328: {
329: // *
330: // * Swapping involves at least one 2-by-2 block.
331: // *
332: // * Copy the diagonal block of order N1+N2 to the local array D
333: // * and compute its norm.
334: // *
335: ND = N1 + N2;
336: this._dlacpy.Run("Full", ND, ND, T, J1+J1 * LDT + o_t, LDT, ref D, offset_d
337: , LDD);
338: DNORM = this._dlange.Run("Max", ND, ND, D, offset_d, LDD, ref WORK, offset_work);
339: // *
340: // * Compute machine-dependent threshold for test for accepting
341: // * swap.
342: // *
343: EPS = this._dlamch.Run("P");
344: SMLNUM = this._dlamch.Run("S") / EPS;
345: THRESH = Math.Max(TEN * EPS * DNORM, SMLNUM);
346: // *
347: // * Solve T11*X - X*T22 = scale*T12 for X.
348: // *
349: this._dlasy2.Run(false, false, - 1, N1, N2, D, offset_d
350: , LDD, D, N1 + 1+(N1 + 1) * LDD + o_d, LDD, D, 1+(N1 + 1) * LDD + o_d, LDD, ref SCALE
351: , ref X, offset_x, LDX, ref XNORM, ref IERR);
352: // *
353: // * Swap the adjacent diagonal blocks.
354: // *
355: K = N1 + N1 + N2 - 3;
356: switch (K)
357: {
358: case 1: goto LABEL10;
359: case 2: goto LABEL20;
360: case 3: goto LABEL30;
361: }
362: // *
363: LABEL10:;
364: // *
365: // * N1 = 1, N2 = 2: generate elementary reflector H so that:
366: // *
367: // * ( scale, X11, X12 ) H = ( 0, 0, * )
368: // *
369: U[1 + o_u] = SCALE;
370: U[2 + o_u] = X[1+1 * LDX + o_x];
371: U[3 + o_u] = X[1+2 * LDX + o_x];
372: this._dlarfg.Run(3, ref U[3 + o_u], ref U, offset_u, 1, ref TAU);
373: U[3 + o_u] = ONE;
374: T11 = T[J1+J1 * LDT + o_t];
375: // *
376: // * Perform swap provisionally on diagonal block in D.
377: // *
378: this._dlarfx.Run("L", 3, 3, U, offset_u, TAU, ref D, offset_d
379: , LDD, ref WORK, offset_work);
380: this._dlarfx.Run("R", 3, 3, U, offset_u, TAU, ref D, offset_d
381: , LDD, ref WORK, offset_work);
382: // *
383: // * Test whether to reject swap.
384: // *
385: if (Math.Max(Math.Abs(D[3+1 * LDD + o_d]), Math.Max(Math.Abs(D[3+2 * LDD + o_d]), Math.Abs(D[3+3 * LDD + o_d] - T11))) > THRESH) goto LABEL50;
386: // *
387: // * Accept swap: apply transformation to the entire matrix T.
388: // *
389: this._dlarfx.Run("L", 3, N - J1 + 1, U, offset_u, TAU, ref T, J1+J1 * LDT + o_t
390: , LDT, ref WORK, offset_work);
391: this._dlarfx.Run("R", J2, 3, U, offset_u, TAU, ref T, 1+J1 * LDT + o_t
392: , LDT, ref WORK, offset_work);
393: // *
394: T[J3+J1 * LDT + o_t] = ZERO;
395: T[J3+J2 * LDT + o_t] = ZERO;
396: T[J3+J3 * LDT + o_t] = T11;
397: // *
398: if (WANTQ)
399: {
400: // *
401: // * Accumulate transformation in the matrix Q.
402: // *
403: this._dlarfx.Run("R", N, 3, U, offset_u, TAU, ref Q, 1+J1 * LDQ + o_q
404: , LDQ, ref WORK, offset_work);
405: }
406: goto LABEL40;
407: // *
408: LABEL20:;
409: // *
410: // * N1 = 2, N2 = 1: generate elementary reflector H so that:
411: // *
412: // * H ( -X11 ) = ( * )
413: // * ( -X21 ) = ( 0 )
414: // * ( scale ) = ( 0 )
415: // *
416: U[1 + o_u] = - X[1+1 * LDX + o_x];
417: U[2 + o_u] = - X[2+1 * LDX + o_x];
418: U[3 + o_u] = SCALE;
419: this._dlarfg.Run(3, ref U[1 + o_u], ref U, 2 + o_u, 1, ref TAU);
420: U[1 + o_u] = ONE;
421: T33 = T[J3+J3 * LDT + o_t];
422: // *
423: // * Perform swap provisionally on diagonal block in D.
424: // *
425: this._dlarfx.Run("L", 3, 3, U, offset_u, TAU, ref D, offset_d
426: , LDD, ref WORK, offset_work);
427: this._dlarfx.Run("R", 3, 3, U, offset_u, TAU, ref D, offset_d
428: , LDD, ref WORK, offset_work);
429: // *
430: // * Test whether to reject swap.
431: // *
432: if (Math.Max(Math.Abs(D[2+1 * LDD + o_d]), Math.Max(Math.Abs(D[3+1 * LDD + o_d]), Math.Abs(D[1+1 * LDD + o_d] - T33))) > THRESH) goto LABEL50;
433: // *
434: // * Accept swap: apply transformation to the entire matrix T.
435: // *
436: this._dlarfx.Run("R", J3, 3, U, offset_u, TAU, ref T, 1+J1 * LDT + o_t
437: , LDT, ref WORK, offset_work);
438: this._dlarfx.Run("L", 3, N - J1, U, offset_u, TAU, ref T, J1+J2 * LDT + o_t
439: , LDT, ref WORK, offset_work);
440: // *
441: T[J1+J1 * LDT + o_t] = T33;
442: T[J2+J1 * LDT + o_t] = ZERO;
443: T[J3+J1 * LDT + o_t] = ZERO;
444: // *
445: if (WANTQ)
446: {
447: // *
448: // * Accumulate transformation in the matrix Q.
449: // *
450: this._dlarfx.Run("R", N, 3, U, offset_u, TAU, ref Q, 1+J1 * LDQ + o_q
451: , LDQ, ref WORK, offset_work);
452: }
453: goto LABEL40;
454: // *
455: LABEL30:;
456: // *
457: // * N1 = 2, N2 = 2: generate elementary reflectors H(1) and H(2) so
458: // * that:
459: // *
460: // * H(2) H(1) ( -X11 -X12 ) = ( * * )
461: // * ( -X21 -X22 ) ( 0 * )
462: // * ( scale 0 ) ( 0 0 )
463: // * ( 0 scale ) ( 0 0 )
464: // *
465: U1[1 + o_u1] = - X[1+1 * LDX + o_x];
466: U1[2 + o_u1] = - X[2+1 * LDX + o_x];
467: U1[3 + o_u1] = SCALE;
468: this._dlarfg.Run(3, ref U1[1 + o_u1], ref U1, 2 + o_u1, 1, ref TAU1);
469: U1[1 + o_u1] = ONE;
470: // *
471: TEMP = - TAU1 * (X[1+2 * LDX + o_x] + U1[2 + o_u1] * X[2+2 * LDX + o_x]);
472: U2[1 + o_u2] = - TEMP * U1[2 + o_u1] - X[2+2 * LDX + o_x];
473: U2[2 + o_u2] = - TEMP * U1[3 + o_u1];
474: U2[3 + o_u2] = SCALE;
475: this._dlarfg.Run(3, ref U2[1 + o_u2], ref U2, 2 + o_u2, 1, ref TAU2);
476: U2[1 + o_u2] = ONE;
477: // *
478: // * Perform swap provisionally on diagonal block in D.
479: // *
480: this._dlarfx.Run("L", 3, 4, U1, offset_u1, TAU1, ref D, offset_d
481: , LDD, ref WORK, offset_work);
482: this._dlarfx.Run("R", 4, 3, U1, offset_u1, TAU1, ref D, offset_d
483: , LDD, ref WORK, offset_work);
484: this._dlarfx.Run("L", 3, 4, U2, offset_u2, TAU2, ref D, 2+1 * LDD + o_d
485: , LDD, ref WORK, offset_work);
486: this._dlarfx.Run("R", 4, 3, U2, offset_u2, TAU2, ref D, 1+2 * LDD + o_d
487: , LDD, ref WORK, offset_work);
488: // *
489: // * Test whether to reject swap.
490: // *
491: if (Math.Max(Math.Abs(D[3+1 * LDD + o_d]), Math.Max(Math.Abs(D[3+2 * LDD + o_d]), Math.Max(Math.Abs(D[4+1 * LDD + o_d]), Math.Abs(D[4+2 * LDD + o_d])))) > THRESH) goto LABEL50;
492: // *
493: // * Accept swap: apply transformation to the entire matrix T.
494: // *
495: this._dlarfx.Run("L", 3, N - J1 + 1, U1, offset_u1, TAU1, ref T, J1+J1 * LDT + o_t
496: , LDT, ref WORK, offset_work);
497: this._dlarfx.Run("R", J4, 3, U1, offset_u1, TAU1, ref T, 1+J1 * LDT + o_t
498: , LDT, ref WORK, offset_work);
499: this._dlarfx.Run("L", 3, N - J1 + 1, U2, offset_u2, TAU2, ref T, J2+J1 * LDT + o_t
500: , LDT, ref WORK, offset_work);
501: this._dlarfx.Run("R", J4, 3, U2, offset_u2, TAU2, ref T, 1+J2 * LDT + o_t
502: , LDT, ref WORK, offset_work);
503: // *
504: T[J3+J1 * LDT + o_t] = ZERO;
505: T[J3+J2 * LDT + o_t] = ZERO;
506: T[J4+J1 * LDT + o_t] = ZERO;
507: T[J4+J2 * LDT + o_t] = ZERO;
508: // *
509: if (WANTQ)
510: {
511: // *
512: // * Accumulate transformation in the matrix Q.
513: // *
514: this._dlarfx.Run("R", N, 3, U1, offset_u1, TAU1, ref Q, 1+J1 * LDQ + o_q
515: , LDQ, ref WORK, offset_work);
516: this._dlarfx.Run("R", N, 3, U2, offset_u2, TAU2, ref Q, 1+J2 * LDQ + o_q
517: , LDQ, ref WORK, offset_work);
518: }
519: // *
520: LABEL40:;
521: // *
522: if (N2 == 2)
523: {
524: // *
525: // * Standardize new 2-by-2 block T11
526: // *
527: this._dlanv2.Run(ref T[J1+J1 * LDT + o_t], ref T[J1+J2 * LDT + o_t], ref T[J2+J1 * LDT + o_t], ref T[J2+J2 * LDT + o_t], ref WR1, ref WI1
528: , ref WR2, ref WI2, ref CS, ref SN);
529: this._drot.Run(N - J1 - 1, ref T, J1+(J1 + 2) * LDT + o_t, LDT, ref T, J2+(J1 + 2) * LDT + o_t, LDT, CS
530: , SN);
531: this._drot.Run(J1 - 1, ref T, 1+J1 * LDT + o_t, 1, ref T, 1+J2 * LDT + o_t, 1, CS
532: , SN);
533: if (WANTQ)
534: {
535: this._drot.Run(N, ref Q, 1+J1 * LDQ + o_q, 1, ref Q, 1+J2 * LDQ + o_q, 1, CS
536: , SN);
537: }
538: }
539: // *
540: if (N1 == 2)
541: {
542: // *
543: // * Standardize new 2-by-2 block T22
544: // *
545: J3 = J1 + N2;
546: J4 = J3 + 1;
547: this._dlanv2.Run(ref T[J3+J3 * LDT + o_t], ref T[J3+J4 * LDT + o_t], ref T[J4+J3 * LDT + o_t], ref T[J4+J4 * LDT + o_t], ref WR1, ref WI1
548: , ref WR2, ref WI2, ref CS, ref SN);
549: if (J3 + 2 <= N)
550: {
551: this._drot.Run(N - J3 - 1, ref T, J3+(J3 + 2) * LDT + o_t, LDT, ref T, J4+(J3 + 2) * LDT + o_t, LDT, CS
552: , SN);
553: }
554: this._drot.Run(J3 - 1, ref T, 1+J3 * LDT + o_t, 1, ref T, 1+J4 * LDT + o_t, 1, CS
555: , SN);
556: if (WANTQ)
557: {
558: this._drot.Run(N, ref Q, 1+J3 * LDQ + o_q, 1, ref Q, 1+J4 * LDQ + o_q, 1, CS
559: , SN);
560: }
561: }
562: // *
563: }
564: return;
565: // *
566: // * Exit with INFO = 1 if swap was rejected.
567: // *
568: LABEL50:;
569: INFO = 1;
570: return;
571: // *
572: // * End of DLAEXC
573: // *
574:
575: #endregion
576:
577: }
578: }
579: }