LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slaqz3.f
Go to the documentation of this file.
1*> \brief \b SLAQZ3
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SLAQZ3 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqz3.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqz3.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqz3.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SLAQZ3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW, A, LDA, B,
22* $ LDB, Q, LDQ, Z, LDZ, NS, ND, ALPHAR, ALPHAI, BETA, QC, LDQC,
23* $ ZC, LDZC, WORK, LWORK, REC, INFO )
24* IMPLICIT NONE
25*
26* Arguments
27* LOGICAL, INTENT( IN ) :: ILSCHUR, ILQ, ILZ
28* INTEGER, INTENT( IN ) :: N, ILO, IHI, NW, LDA, LDB, LDQ, LDZ,
29* $ LDQC, LDZC, LWORK, REC
30*
31* REAL, INTENT( INOUT ) :: A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
32* $ Z( LDZ, * ), ALPHAR( * ), ALPHAI( * ), BETA( * )
33* INTEGER, INTENT( OUT ) :: NS, ND, INFO
34* REAL :: QC( LDQC, * ), ZC( LDZC, * ), WORK( * )
35* ..
36*
37*
38*> \par Purpose:
39* =============
40*>
41*> \verbatim
42*>
43*> SLAQZ3 performs AED
44*> \endverbatim
45*
46* Arguments:
47* ==========
48*
49*> \param[in] ILSCHUR
50*> \verbatim
51*> ILSCHUR is LOGICAL
52*> Determines whether or not to update the full Schur form
53*> \endverbatim
54*> \param[in] ILQ
55*> \verbatim
56*> ILQ is LOGICAL
57*> Determines whether or not to update the matrix Q
58*> \endverbatim
59*>
60*> \param[in] ILZ
61*> \verbatim
62*> ILZ is LOGICAL
63*> Determines whether or not to update the matrix Z
64*> \endverbatim
65*>
66*> \param[in] N
67*> \verbatim
68*> N is INTEGER
69*> The order of the matrices A, B, Q, and Z. N >= 0.
70*> \endverbatim
71*>
72*> \param[in] ILO
73*> \verbatim
74*> ILO is INTEGER
75*> \endverbatim
76*>
77*> \param[in] IHI
78*> \verbatim
79*> IHI is INTEGER
80*> ILO and IHI mark the rows and columns of (A,B) which
81*> are to be normalized
82*> \endverbatim
83*>
84*> \param[in] NW
85*> \verbatim
86*> NW is INTEGER
87*> The desired size of the deflation window.
88*> \endverbatim
89*>
90*> \param[in,out] A
91*> \verbatim
92*> A is REAL array, dimension (LDA, N)
93*> \endverbatim
94*>
95*> \param[in] LDA
96*> \verbatim
97*> LDA is INTEGER
98*> The leading dimension of the array A. LDA >= max( 1, N ).
99*> \endverbatim
100*>
101*> \param[in,out] B
102*> \verbatim
103*> B is REAL array, dimension (LDB, N)
104*> \endverbatim
105*>
106*> \param[in] LDB
107*> \verbatim
108*> LDB is INTEGER
109*> The leading dimension of the array B. LDB >= max( 1, N ).
110*> \endverbatim
111*>
112*> \param[in,out] Q
113*> \verbatim
114*> Q is REAL array, dimension (LDQ, N)
115*> \endverbatim
116*>
117*> \param[in] LDQ
118*> \verbatim
119*> LDQ is INTEGER
120*> \endverbatim
121*>
122*> \param[in,out] Z
123*> \verbatim
124*> Z is REAL array, dimension (LDZ, N)
125*> \endverbatim
126*>
127*> \param[in] LDZ
128*> \verbatim
129*> LDZ is INTEGER
130*> \endverbatim
131*>
132*> \param[out] NS
133*> \verbatim
134*> NS is INTEGER
135*> The number of unconverged eigenvalues available to
136*> use as shifts.
137*> \endverbatim
138*>
139*> \param[out] ND
140*> \verbatim
141*> ND is INTEGER
142*> The number of converged eigenvalues found.
143*> \endverbatim
144*>
145*> \param[out] ALPHAR
146*> \verbatim
147*> ALPHAR is REAL array, dimension (N)
148*> The real parts of each scalar alpha defining an eigenvalue
149*> of GNEP.
150*> \endverbatim
151*>
152*> \param[out] ALPHAI
153*> \verbatim
154*> ALPHAI is REAL array, dimension (N)
155*> The imaginary parts of each scalar alpha defining an
156*> eigenvalue of GNEP.
157*> If ALPHAI(j) is zero, then the j-th eigenvalue is real; if
158*> positive, then the j-th and (j+1)-st eigenvalues are a
159*> complex conjugate pair, with ALPHAI(j+1) = -ALPHAI(j).
160*> \endverbatim
161*>
162*> \param[out] BETA
163*> \verbatim
164*> BETA is REAL array, dimension (N)
165*> The scalars beta that define the eigenvalues of GNEP.
166*> Together, the quantities alpha = (ALPHAR(j),ALPHAI(j)) and
167*> beta = BETA(j) represent the j-th eigenvalue of the matrix
168*> pair (A,B), in one of the forms lambda = alpha/beta or
169*> mu = beta/alpha. Since either lambda or mu may overflow,
170*> they should not, in general, be computed.
171*> \endverbatim
172*>
173*> \param[in,out] QC
174*> \verbatim
175*> QC is REAL array, dimension (LDQC, NW)
176*> \endverbatim
177*>
178*> \param[in] LDQC
179*> \verbatim
180*> LDQC is INTEGER
181*> \endverbatim
182*>
183*> \param[in,out] ZC
184*> \verbatim
185*> ZC is REAL array, dimension (LDZC, NW)
186*> \endverbatim
187*>
188*> \param[in] LDZC
189*> \verbatim
190*> LDZ is INTEGER
191*> \endverbatim
192*>
193*> \param[out] WORK
194*> \verbatim
195*> WORK is REAL array, dimension (MAX(1,LWORK))
196*> On exit, if INFO >= 0, WORK(1) returns the optimal LWORK.
197*> \endverbatim
198*>
199*> \param[in] LWORK
200*> \verbatim
201*> LWORK is INTEGER
202*> The dimension of the array WORK. LWORK >= max(1,N).
203*>
204*> If LWORK = -1, then a workspace query is assumed; the routine
205*> only calculates the optimal size of the WORK array, returns
206*> this value as the first entry of the WORK array, and no error
207*> message related to LWORK is issued by XERBLA.
208*> \endverbatim
209*>
210*> \param[in] REC
211*> \verbatim
212*> REC is INTEGER
213*> REC indicates the current recursion level. Should be set
214*> to 0 on first call.
215*> \endverbatim
216*>
217*> \param[out] INFO
218*> \verbatim
219*> INFO is INTEGER
220*> = 0: successful exit
221*> < 0: if INFO = -i, the i-th argument had an illegal value
222*> \endverbatim
223*
224* Authors:
225* ========
226*
227*> \author Thijs Steel, KU Leuven
228*
229*> \date May 2020
230*
231*> \ingroup laqz3
232*>
233* =====================================================================
234 RECURSIVE SUBROUTINE slaqz3( ILSCHUR, ILQ, ILZ, N, ILO, IHI, NW,
235 $ A, LDA, B, LDB, Q, LDQ, Z, LDZ, NS,
236 $ ND, ALPHAR, ALPHAI, BETA, QC, LDQC,
237 $ ZC, LDZC, WORK, LWORK, REC, INFO )
238 IMPLICIT NONE
239
240* Arguments
241 LOGICAL, INTENT( IN ) :: ilschur, ilq, ilz
242 INTEGER, INTENT( IN ) :: n, ilo, ihi, nw, lda, ldb, ldq, ldz,
243 $ ldqc, ldzc, lwork, rec
244
245 REAL, INTENT( INOUT ) :: a( lda, * ), b( ldb, * ), q( ldq, * ),
246 $ z( ldz, * ), alphar( * ), alphai( * ), beta( * )
247 INTEGER, INTENT( OUT ) :: ns, nd, info
248 REAL :: qc( ldqc, * ), zc( ldzc, * ), work( * )
249
250* Parameters
251 REAL :: zero, one, half
252 PARAMETER( zero = 0.0, one = 1.0, half = 0.5 )
253
254* Local Scalars
255 LOGICAL :: bulge
256 INTEGER :: jw, kwtop, kwbot, istopm, istartm, k, k2, stgexc_info,
257 $ ifst, ilst, lworkreq, qz_small_info
258 REAL :: s, smlnum, ulp, safmin, safmax, c1, s1, temp
259
260* External Functions
261 EXTERNAL :: xerbla, stgexc, slaqz0, slacpy, slaset,
262 $ slaqz2, srot, slartg, slag2, sgemm
263 REAL, EXTERNAL :: slamch, sroundup_lwork
264
265 info = 0
266
267* Set up deflation window
268 jw = min( nw, ihi-ilo+1 )
269 kwtop = ihi-jw+1
270 IF ( kwtop .EQ. ilo ) THEN
271 s = zero
272 ELSE
273 s = a( kwtop, kwtop-1 )
274 END IF
275
276* Determine required workspace
277 ifst = 1
278 ilst = jw
279 CALL stgexc( .true., .true., jw, a, lda, b, ldb, qc, ldqc, zc,
280 $ ldzc, ifst, ilst, work, -1, stgexc_info )
281 lworkreq = int( work( 1 ) )
282 CALL slaqz0( 'S', 'V', 'V', jw, 1, jw, a( kwtop, kwtop ), lda,
283 $ b( kwtop, kwtop ), ldb, alphar, alphai, beta, qc,
284 $ ldqc, zc, ldzc, work, -1, rec+1, qz_small_info )
285 lworkreq = max( lworkreq, int( work( 1 ) )+2*jw**2 )
286 lworkreq = max( lworkreq, n*nw, 2*nw**2+n )
287 IF ( lwork .EQ.-1 ) THEN
288* workspace query, quick return
289 work( 1 ) = sroundup_lwork(lworkreq)
290 RETURN
291 ELSE IF ( lwork .LT. lworkreq ) THEN
292 info = -26
293 END IF
294
295 IF( info.NE.0 ) THEN
296 CALL xerbla( 'SLAQZ3', -info )
297 RETURN
298 END IF
299
300* Get machine constants
301 safmin = slamch( 'SAFE MINIMUM' )
302 safmax = one/safmin
303 ulp = slamch( 'PRECISION' )
304 smlnum = safmin*( real( n )/ulp )
305
306 IF ( ihi .EQ. kwtop ) THEN
307* 1 by 1 deflation window, just try a regular deflation
308 alphar( kwtop ) = a( kwtop, kwtop )
309 alphai( kwtop ) = zero
310 beta( kwtop ) = b( kwtop, kwtop )
311 ns = 1
312 nd = 0
313 IF ( abs( s ) .LE. max( smlnum, ulp*abs( a( kwtop,
314 $ kwtop ) ) ) ) THEN
315 ns = 0
316 nd = 1
317 IF ( kwtop .GT. ilo ) THEN
318 a( kwtop, kwtop-1 ) = zero
319 END IF
320 END IF
321 END IF
322
323
324* Store window in case of convergence failure
325 CALL slacpy( 'ALL', jw, jw, a( kwtop, kwtop ), lda, work, jw )
326 CALL slacpy( 'ALL', jw, jw, b( kwtop, kwtop ), ldb, work( jw**2+
327 $ 1 ), jw )
328
329* Transform window to real schur form
330 CALL slaset( 'FULL', jw, jw, zero, one, qc, ldqc )
331 CALL slaset( 'FULL', jw, jw, zero, one, zc, ldzc )
332 CALL slaqz0( 'S', 'V', 'V', jw, 1, jw, a( kwtop, kwtop ), lda,
333 $ b( kwtop, kwtop ), ldb, alphar, alphai, beta, qc,
334 $ ldqc, zc, ldzc, work( 2*jw**2+1 ), lwork-2*jw**2,
335 $ rec+1, qz_small_info )
336
337 IF( qz_small_info .NE. 0 ) THEN
338* Convergence failure, restore the window and exit
339 nd = 0
340 ns = jw-qz_small_info
341 CALL slacpy( 'ALL', jw, jw, work, jw, a( kwtop, kwtop ), lda )
342 CALL slacpy( 'ALL', jw, jw, work( jw**2+1 ), jw, b( kwtop,
343 $ kwtop ), ldb )
344 RETURN
345 END IF
346
347* Deflation detection loop
348 IF ( kwtop .EQ. ilo .OR. s .EQ. zero ) THEN
349 kwbot = kwtop-1
350 ELSE
351 kwbot = ihi
352 k = 1
353 k2 = 1
354 DO WHILE ( k .LE. jw )
355 bulge = .false.
356 IF ( kwbot-kwtop+1 .GE. 2 ) THEN
357 bulge = a( kwbot, kwbot-1 ) .NE. zero
358 END IF
359 IF ( bulge ) THEN
360
361* Try to deflate complex conjugate eigenvalue pair
362 temp = abs( a( kwbot, kwbot ) )+sqrt( abs( a( kwbot,
363 $ kwbot-1 ) ) )*sqrt( abs( a( kwbot-1, kwbot ) ) )
364 IF( temp .EQ. zero )THEN
365 temp = abs( s )
366 END IF
367 IF ( max( abs( s*qc( 1, kwbot-kwtop ) ), abs( s*qc( 1,
368 $ kwbot-kwtop+1 ) ) ) .LE. max( smlnum,
369 $ ulp*temp ) ) THEN
370* Deflatable
371 kwbot = kwbot-2
372 ELSE
373* Not deflatable, move out of the way
374 ifst = kwbot-kwtop+1
375 ilst = k2
376 CALL stgexc( .true., .true., jw, a( kwtop, kwtop ),
377 $ lda, b( kwtop, kwtop ), ldb, qc, ldqc,
378 $ zc, ldzc, ifst, ilst, work, lwork,
379 $ stgexc_info )
380 k2 = k2+2
381 END IF
382 k = k+2
383 ELSE
384
385* Try to deflate real eigenvalue
386 temp = abs( a( kwbot, kwbot ) )
387 IF( temp .EQ. zero ) THEN
388 temp = abs( s )
389 END IF
390 IF ( ( abs( s*qc( 1, kwbot-kwtop+1 ) ) ) .LE. max( ulp*
391 $ temp, smlnum ) ) THEN
392* Deflatable
393 kwbot = kwbot-1
394 ELSE
395* Not deflatable, move out of the way
396 ifst = kwbot-kwtop+1
397 ilst = k2
398 CALL stgexc( .true., .true., jw, a( kwtop, kwtop ),
399 $ lda, b( kwtop, kwtop ), ldb, qc, ldqc,
400 $ zc, ldzc, ifst, ilst, work, lwork,
401 $ stgexc_info )
402 k2 = k2+1
403 END IF
404
405 k = k+1
406
407 END IF
408 END DO
409 END IF
410
411* Store eigenvalues
412 nd = ihi-kwbot
413 ns = jw-nd
414 k = kwtop
415 DO WHILE ( k .LE. ihi )
416 bulge = .false.
417 IF ( k .LT. ihi ) THEN
418 IF ( a( k+1, k ) .NE. zero ) THEN
419 bulge = .true.
420 END IF
421 END IF
422 IF ( bulge ) THEN
423* 2x2 eigenvalue block
424 CALL slag2( a( k, k ), lda, b( k, k ), ldb, safmin,
425 $ beta( k ), beta( k+1 ), alphar( k ),
426 $ alphar( k+1 ), alphai( k ) )
427 alphai( k+1 ) = -alphai( k )
428 k = k+2
429 ELSE
430* 1x1 eigenvalue block
431 alphar( k ) = a( k, k )
432 alphai( k ) = zero
433 beta( k ) = b( k, k )
434 k = k+1
435 END IF
436 END DO
437
438 IF ( kwtop .NE. ilo .AND. s .NE. zero ) THEN
439* Reflect spike back, this will create optimally packed bulges
440 a( kwtop:kwbot, kwtop-1 ) = a( kwtop, kwtop-1 )*qc( 1,
441 $ 1:jw-nd )
442 DO k = kwbot-1, kwtop, -1
443 CALL slartg( a( k, kwtop-1 ), a( k+1, kwtop-1 ), c1, s1,
444 $ temp )
445 a( k, kwtop-1 ) = temp
446 a( k+1, kwtop-1 ) = zero
447 k2 = max( kwtop, k-1 )
448 CALL srot( ihi-k2+1, a( k, k2 ), lda, a( k+1, k2 ), lda, c1,
449 $ s1 )
450 CALL srot( ihi-( k-1 )+1, b( k, k-1 ), ldb, b( k+1, k-1 ),
451 $ ldb, c1, s1 )
452 CALL srot( jw, qc( 1, k-kwtop+1 ), 1, qc( 1, k+1-kwtop+1 ),
453 $ 1, c1, s1 )
454 END DO
455
456* Chase bulges down
457 istartm = kwtop
458 istopm = ihi
459 k = kwbot-1
460 DO WHILE ( k .GE. kwtop )
461 IF ( ( k .GE. kwtop+1 ) .AND. a( k+1, k-1 ) .NE. zero ) THEN
462
463* Move double pole block down and remove it
464 DO k2 = k-1, kwbot-2
465 CALL slaqz2( .true., .true., k2, kwtop, kwtop+jw-1,
466 $ kwbot, a, lda, b, ldb, jw, kwtop, qc,
467 $ ldqc, jw, kwtop, zc, ldzc )
468 END DO
469
470 k = k-2
471 ELSE
472
473* k points to single shift
474 DO k2 = k, kwbot-2
475
476* Move shift down
477 CALL slartg( b( k2+1, k2+1 ), b( k2+1, k2 ), c1, s1,
478 $ temp )
479 b( k2+1, k2+1 ) = temp
480 b( k2+1, k2 ) = zero
481 CALL srot( k2+2-istartm+1, a( istartm, k2+1 ), 1,
482 $ a( istartm, k2 ), 1, c1, s1 )
483 CALL srot( k2-istartm+1, b( istartm, k2+1 ), 1,
484 $ b( istartm, k2 ), 1, c1, s1 )
485 CALL srot( jw, zc( 1, k2+1-kwtop+1 ), 1, zc( 1,
486 $ k2-kwtop+1 ), 1, c1, s1 )
487
488 CALL slartg( a( k2+1, k2 ), a( k2+2, k2 ), c1, s1,
489 $ temp )
490 a( k2+1, k2 ) = temp
491 a( k2+2, k2 ) = zero
492 CALL srot( istopm-k2, a( k2+1, k2+1 ), lda, a( k2+2,
493 $ k2+1 ), lda, c1, s1 )
494 CALL srot( istopm-k2, b( k2+1, k2+1 ), ldb, b( k2+2,
495 $ k2+1 ), ldb, c1, s1 )
496 CALL srot( jw, qc( 1, k2+1-kwtop+1 ), 1, qc( 1,
497 $ k2+2-kwtop+1 ), 1, c1, s1 )
498
499 END DO
500
501* Remove the shift
502 CALL slartg( b( kwbot, kwbot ), b( kwbot, kwbot-1 ), c1,
503 $ s1, temp )
504 b( kwbot, kwbot ) = temp
505 b( kwbot, kwbot-1 ) = zero
506 CALL srot( kwbot-istartm, b( istartm, kwbot ), 1,
507 $ b( istartm, kwbot-1 ), 1, c1, s1 )
508 CALL srot( kwbot-istartm+1, a( istartm, kwbot ), 1,
509 $ a( istartm, kwbot-1 ), 1, c1, s1 )
510 CALL srot( jw, zc( 1, kwbot-kwtop+1 ), 1, zc( 1,
511 $ kwbot-1-kwtop+1 ), 1, c1, s1 )
512
513 k = k-1
514 END IF
515 END DO
516
517 END IF
518
519* Apply Qc and Zc to rest of the matrix
520 IF ( ilschur ) THEN
521 istartm = 1
522 istopm = n
523 ELSE
524 istartm = ilo
525 istopm = ihi
526 END IF
527
528 IF ( istopm-ihi > 0 ) THEN
529 CALL sgemm( 'T', 'N', jw, istopm-ihi, jw, one, qc, ldqc,
530 $ a( kwtop, ihi+1 ), lda, zero, work, jw )
531 CALL slacpy( 'ALL', jw, istopm-ihi, work, jw, a( kwtop,
532 $ ihi+1 ), lda )
533 CALL sgemm( 'T', 'N', jw, istopm-ihi, jw, one, qc, ldqc,
534 $ b( kwtop, ihi+1 ), ldb, zero, work, jw )
535 CALL slacpy( 'ALL', jw, istopm-ihi, work, jw, b( kwtop,
536 $ ihi+1 ), ldb )
537 END IF
538 IF ( ilq ) THEN
539 CALL sgemm( 'N', 'N', n, jw, jw, one, q( 1, kwtop ), ldq, qc,
540 $ ldqc, zero, work, n )
541 CALL slacpy( 'ALL', n, jw, work, n, q( 1, kwtop ), ldq )
542 END IF
543
544 IF ( kwtop-1-istartm+1 > 0 ) THEN
545 CALL sgemm( 'N', 'N', kwtop-istartm, jw, jw, one, a( istartm,
546 $ kwtop ), lda, zc, ldzc, zero, work,
547 $ kwtop-istartm )
548 CALL slacpy( 'ALL', kwtop-istartm, jw, work, kwtop-istartm,
549 $ a( istartm, kwtop ), lda )
550 CALL sgemm( 'N', 'N', kwtop-istartm, jw, jw, one, b( istartm,
551 $ kwtop ), ldb, zc, ldzc, zero, work,
552 $ kwtop-istartm )
553 CALL slacpy( 'ALL', kwtop-istartm, jw, work, kwtop-istartm,
554 $ b( istartm, kwtop ), ldb )
555 END IF
556 IF ( ilz ) THEN
557 CALL sgemm( 'N', 'N', n, jw, jw, one, z( 1, kwtop ), ldz, zc,
558 $ ldzc, zero, work, n )
559 CALL slacpy( 'ALL', n, jw, work, n, z( 1, kwtop ), ldz )
560 END IF
561
562 END SUBROUTINE
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
sgemm
subroutine sgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
SGEMM
Definition sgemm.f:188
slacpy
subroutine slacpy(uplo, m, n, a, lda, b, ldb)
SLACPY copies all or part of one two-dimensional array to another.
Definition slacpy.f:103
slag2
subroutine slag2(a, lda, b, ldb, safmin, scale1, scale2, wr1, wr2, wi)
SLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary ...
Definition slag2.f:156
slamch
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
slaqz0
recursive subroutine slaqz0(wants, wantq, wantz, n, ilo, ihi, a, lda, b, ldb, alphar, alphai, beta, q, ldq, z, ldz, work, lwork, rec, info)
SLAQZ0
Definition slaqz0.f:304
slaqz2
subroutine slaqz2(ilq, ilz, k, istartm, istopm, ihi, a, lda, b, ldb, nq, qstart, q, ldq, nz, zstart, z, ldz)
SLAQZ2
Definition slaqz2.f:173
slaqz3
recursive subroutine slaqz3(ilschur, ilq, ilz, n, ilo, ihi, nw, a, lda, b, ldb, q, ldq, z, ldz, ns, nd, alphar, alphai, beta, qc, ldqc, zc, ldzc, work, lwork, rec, info)
SLAQZ3
Definition slaqz3.f:238
slartg
subroutine slartg(f, g, c, s, r)
SLARTG generates a plane rotation with real cosine and real sine.
Definition slartg.f90:111
slaset
subroutine slaset(uplo, m, n, alpha, beta, a, lda)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition slaset.f:110
srot
subroutine srot(n, sx, incx, sy, incy, c, s)
SROT
Definition srot.f:92
sroundup_lwork
real function sroundup_lwork(lwork)
SROUNDUP_LWORK
Definition sroundup_lwork.f:59
stgexc
subroutine stgexc(wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz, ifst, ilst, work, lwork, info)
STGEXC
Definition stgexc.f:220