3 * =========== DOCUMENTATION ===========
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
9 *> Download STRSYL + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strsyl.f">
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strsyl.f">
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strsyl.f">
21 * SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
24 * .. Scalar Arguments ..
25 * CHARACTER TRANA, TRANB
26 * INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
29 * .. Array Arguments ..
30 * REAL A( LDA, * ), B( LDB, * ), C( LDC, * )
39 *> STRSYL solves the real Sylvester matrix equation:
41 *> op(A)*X + X*op(B) = scale*C or
42 *> op(A)*X - X*op(B) = scale*C,
44 *> where op(A) = A or A**T, and A and B are both upper quasi-
45 *> triangular. A is M-by-M and B is N-by-N; the right hand side C and
46 *> the solution X are M-by-N; and scale is an output scale factor, set
47 *> <= 1 to avoid overflow in X.
49 *> A and B must be in Schur canonical form (as returned by SHSEQR), that
50 *> is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks;
51 *> each 2-by-2 diagonal block has its diagonal elements equal and its
52 *> off-diagonal elements of opposite sign.
60 *> TRANA is CHARACTER*1
61 *> Specifies the option op(A):
62 *> = 'N': op(A) = A (No transpose)
63 *> = 'T': op(A) = A**T (Transpose)
64 *> = 'C': op(A) = A**H (Conjugate transpose = Transpose)
69 *> TRANB is CHARACTER*1
70 *> Specifies the option op(B):
71 *> = 'N': op(B) = B (No transpose)
72 *> = 'T': op(B) = B**T (Transpose)
73 *> = 'C': op(B) = B**H (Conjugate transpose = Transpose)
79 *> Specifies the sign in the equation:
80 *> = +1: solve op(A)*X + X*op(B) = scale*C
81 *> = -1: solve op(A)*X - X*op(B) = scale*C
87 *> The order of the matrix A, and the number of rows in the
88 *> matrices X and C. M >= 0.
94 *> The order of the matrix B, and the number of columns in the
95 *> matrices X and C. N >= 0.
100 *> A is REAL array, dimension (LDA,M)
101 *> The upper quasi-triangular matrix A, in Schur canonical form.
107 *> The leading dimension of the array A. LDA >= max(1,M).
112 *> B is REAL array, dimension (LDB,N)
113 *> The upper quasi-triangular matrix B, in Schur canonical form.
119 *> The leading dimension of the array B. LDB >= max(1,N).
124 *> C is REAL array, dimension (LDC,N)
125 *> On entry, the M-by-N right hand side matrix C.
126 *> On exit, C is overwritten by the solution matrix X.
132 *> The leading dimension of the array C. LDC >= max(1,M)
138 *> The scale factor, scale, set <= 1 to avoid overflow in X.
144 *> = 0: successful exit
145 *> < 0: if INFO = -i, the i-th argument had an illegal value
146 *> = 1: A and B have common or very close eigenvalues; perturbed
147 *> values were used to solve the equation (but the matrices
148 *> A and B are unchanged).
154 *> \author Univ. of Tennessee
155 *> \author Univ. of California Berkeley
156 *> \author Univ. of Colorado Denver
159 *> \date November 2011
161 *> \ingroup realSYcomputational
163 * =====================================================================
164 SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
167 * -- LAPACK computational routine (version 3.4.0) --
168 * -- LAPACK is a software package provided by Univ. of Tennessee, --
169 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172 * .. Scalar Arguments ..
173 CHARACTER TRANA, TRANB
174 INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
177 * .. Array Arguments ..
178 REAL A( LDA, * ), B( LDB, * ), C( LDC, * )
181 * =====================================================================
185 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
187 * .. Local Scalars ..
188 LOGICAL NOTRNA, NOTRNB
189 INTEGER IERR, J, K, K1, K2, KNEXT, L, L1, L2, LNEXT
190 REAL A11, BIGNUM, DA11, DB, EPS, SCALOC, SGN, SMIN,
191 $ SMLNUM, SUML, SUMR, XNORM
194 REAL DUM( 1 ), VEC( 2, 2 ), X( 2, 2 )
196 * .. External Functions ..
198 REAL SDOT, SLAMCH, SLANGE
199 EXTERNAL LSAME, SDOT, SLAMCH, SLANGE
201 * .. External Subroutines ..
202 EXTERNAL SLABAD, SLALN2, SLASY2, SSCAL, XERBLA
204 * .. Intrinsic Functions ..
205 INTRINSIC ABS, MAX, MIN, REAL
207 * .. Executable Statements ..
209 * Decode and Test input parameters
211 NOTRNA = LSAME( TRANA, 'N' )
212 NOTRNB = LSAME( TRANB, 'N' )
215 IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'T' ) .AND. .NOT.
216 $ LSAME( TRANA, 'C' ) ) THEN
218 ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'T' ) .AND. .NOT.
219 $ LSAME( TRANB, 'C' ) ) THEN
221 ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
223 ELSE IF( M.LT.0 ) THEN
225 ELSE IF( N.LT.0 ) THEN
227 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
229 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
231 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
235 CALL XERBLA( 'STRSYL', -INFO )
239 * Quick return if possible
242 IF( M.EQ.0 .OR. N.EQ.0 )
245 * Set constants to control overflow
248 SMLNUM = SLAMCH( 'S' )
249 BIGNUM = ONE / SMLNUM
250 CALL SLABAD( SMLNUM, BIGNUM )
251 SMLNUM = SMLNUM*REAL( M*N ) / EPS
252 BIGNUM = ONE / SMLNUM
254 SMIN = MAX( SMLNUM, EPS*SLANGE( 'M', M, M, A, LDA, DUM ),
255 $ EPS*SLANGE( 'M', N, N, B, LDB, DUM ) )
259 IF( NOTRNA .AND. NOTRNB ) THEN
261 * Solve A*X + ISGN*X*B = scale*C.
263 * The (K,L)th block of X is determined starting from
264 * bottom-left corner column by column by
266 * A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
270 * R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)].
273 * Start column loop (index = L)
274 * L1 (L2) : column index of the first (first) row of X(K,L).
284 IF( B( L+1, L ).NE.ZERO ) THEN
295 * Start row loop (index = K)
296 * K1 (K2): row index of the first (last) row of X(K,L).
306 IF( A( K, K-1 ).NE.ZERO ) THEN
317 IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
318 SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
319 $ C( MIN( K1+1, M ), L1 ), 1 )
320 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
321 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
324 A11 = A( K1, K1 ) + SGN*B( L1, L1 )
326 IF( DA11.LE.SMIN ) THEN
331 DB = ABS( VEC( 1, 1 ) )
332 IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
333 IF( DB.GT.BIGNUM*DA11 )
336 X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
338 IF( SCALOC.NE.ONE ) THEN
340 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
344 C( K1, L1 ) = X( 1, 1 )
346 ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
348 SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
349 $ C( MIN( K2+1, M ), L1 ), 1 )
350 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
351 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
353 SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
354 $ C( MIN( K2+1, M ), L1 ), 1 )
355 SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
356 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
358 CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
359 $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
360 $ ZERO, X, 2, SCALOC, XNORM, IERR )
364 IF( SCALOC.NE.ONE ) THEN
366 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
370 C( K1, L1 ) = X( 1, 1 )
371 C( K2, L1 ) = X( 2, 1 )
373 ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
375 SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
376 $ C( MIN( K1+1, M ), L1 ), 1 )
377 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
378 VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
380 SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
381 $ C( MIN( K1+1, M ), L2 ), 1 )
382 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
383 VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
385 CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
386 $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
387 $ ZERO, X, 2, SCALOC, XNORM, IERR )
391 IF( SCALOC.NE.ONE ) THEN
393 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
397 C( K1, L1 ) = X( 1, 1 )
398 C( K1, L2 ) = X( 2, 1 )
400 ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
402 SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
403 $ C( MIN( K2+1, M ), L1 ), 1 )
404 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
405 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
407 SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
408 $ C( MIN( K2+1, M ), L2 ), 1 )
409 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
410 VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
412 SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
413 $ C( MIN( K2+1, M ), L1 ), 1 )
414 SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
415 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
417 SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
418 $ C( MIN( K2+1, M ), L2 ), 1 )
419 SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
420 VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
422 CALL SLASY2( .FALSE., .FALSE., ISGN, 2, 2,
423 $ A( K1, K1 ), LDA, B( L1, L1 ), LDB, VEC,
424 $ 2, SCALOC, X, 2, XNORM, IERR )
428 IF( SCALOC.NE.ONE ) THEN
430 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
434 C( K1, L1 ) = X( 1, 1 )
435 C( K1, L2 ) = X( 1, 2 )
436 C( K2, L1 ) = X( 2, 1 )
437 C( K2, L2 ) = X( 2, 2 )
444 ELSE IF( .NOT.NOTRNA .AND. NOTRNB ) THEN
446 * Solve A**T *X + ISGN*X*B = scale*C.
448 * The (K,L)th block of X is determined starting from
449 * upper-left corner column by column by
451 * A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
455 * R(K,L) = SUM [A(I,K)**T*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)]
458 * Start column loop (index = L)
459 * L1 (L2): column index of the first (last) row of X(K,L)
469 IF( B( L+1, L ).NE.ZERO ) THEN
480 * Start row loop (index = K)
481 * K1 (K2): row index of the first (last) row of X(K,L)
491 IF( A( K+1, K ).NE.ZERO ) THEN
502 IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
503 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
504 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
505 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
508 A11 = A( K1, K1 ) + SGN*B( L1, L1 )
510 IF( DA11.LE.SMIN ) THEN
515 DB = ABS( VEC( 1, 1 ) )
516 IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
517 IF( DB.GT.BIGNUM*DA11 )
520 X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
522 IF( SCALOC.NE.ONE ) THEN
524 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
528 C( K1, L1 ) = X( 1, 1 )
530 ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
532 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
533 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
534 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
536 SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
537 SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
538 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
540 CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
541 $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
542 $ ZERO, X, 2, SCALOC, XNORM, IERR )
546 IF( SCALOC.NE.ONE ) THEN
548 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
552 C( K1, L1 ) = X( 1, 1 )
553 C( K2, L1 ) = X( 2, 1 )
555 ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
557 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
558 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
559 VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
561 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
562 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
563 VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
565 CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, B( L1, L1 ),
566 $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
567 $ ZERO, X, 2, SCALOC, XNORM, IERR )
571 IF( SCALOC.NE.ONE ) THEN
573 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
577 C( K1, L1 ) = X( 1, 1 )
578 C( K1, L2 ) = X( 2, 1 )
580 ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
582 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
583 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L1 ), 1 )
584 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
586 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
587 SUMR = SDOT( L1-1, C( K1, 1 ), LDC, B( 1, L2 ), 1 )
588 VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
590 SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
591 SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L1 ), 1 )
592 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
594 SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
595 SUMR = SDOT( L1-1, C( K2, 1 ), LDC, B( 1, L2 ), 1 )
596 VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
598 CALL SLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, K1 ),
599 $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
604 IF( SCALOC.NE.ONE ) THEN
606 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
610 C( K1, L1 ) = X( 1, 1 )
611 C( K1, L2 ) = X( 1, 2 )
612 C( K2, L1 ) = X( 2, 1 )
613 C( K2, L2 ) = X( 2, 2 )
619 ELSE IF( .NOT.NOTRNA .AND. .NOT.NOTRNB ) THEN
621 * Solve A**T*X + ISGN*X*B**T = scale*C.
623 * The (K,L)th block of X is determined starting from
624 * top-right corner column by column by
626 * A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
630 * R(K,L) = SUM [A(I,K)**T*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
633 * Start column loop (index = L)
634 * L1 (L2): column index of the first (last) row of X(K,L)
644 IF( B( L, L-1 ).NE.ZERO ) THEN
655 * Start row loop (index = K)
656 * K1 (K2): row index of the first (last) row of X(K,L)
666 IF( A( K+1, K ).NE.ZERO ) THEN
677 IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
678 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
679 SUMR = SDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
680 $ B( L1, MIN( L1+1, N ) ), LDB )
681 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
684 A11 = A( K1, K1 ) + SGN*B( L1, L1 )
686 IF( DA11.LE.SMIN ) THEN
691 DB = ABS( VEC( 1, 1 ) )
692 IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
693 IF( DB.GT.BIGNUM*DA11 )
696 X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
698 IF( SCALOC.NE.ONE ) THEN
700 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
704 C( K1, L1 ) = X( 1, 1 )
706 ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
708 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
709 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
710 $ B( L1, MIN( L2+1, N ) ), LDB )
711 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
713 SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
714 SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
715 $ B( L1, MIN( L2+1, N ) ), LDB )
716 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
718 CALL SLALN2( .TRUE., 2, 1, SMIN, ONE, A( K1, K1 ),
719 $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
720 $ ZERO, X, 2, SCALOC, XNORM, IERR )
724 IF( SCALOC.NE.ONE ) THEN
726 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
730 C( K1, L1 ) = X( 1, 1 )
731 C( K2, L1 ) = X( 2, 1 )
733 ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
735 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
736 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
737 $ B( L1, MIN( L2+1, N ) ), LDB )
738 VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
740 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
741 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
742 $ B( L2, MIN( L2+1, N ) ), LDB )
743 VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
745 CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
746 $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
747 $ ZERO, X, 2, SCALOC, XNORM, IERR )
751 IF( SCALOC.NE.ONE ) THEN
753 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
757 C( K1, L1 ) = X( 1, 1 )
758 C( K1, L2 ) = X( 2, 1 )
760 ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
762 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L1 ), 1 )
763 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
764 $ B( L1, MIN( L2+1, N ) ), LDB )
765 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
767 SUML = SDOT( K1-1, A( 1, K1 ), 1, C( 1, L2 ), 1 )
768 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
769 $ B( L2, MIN( L2+1, N ) ), LDB )
770 VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
772 SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L1 ), 1 )
773 SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
774 $ B( L1, MIN( L2+1, N ) ), LDB )
775 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
777 SUML = SDOT( K1-1, A( 1, K2 ), 1, C( 1, L2 ), 1 )
778 SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
779 $ B( L2, MIN(L2+1, N ) ), LDB )
780 VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
782 CALL SLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
783 $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
788 IF( SCALOC.NE.ONE ) THEN
790 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
794 C( K1, L1 ) = X( 1, 1 )
795 C( K1, L2 ) = X( 1, 2 )
796 C( K2, L1 ) = X( 2, 1 )
797 C( K2, L2 ) = X( 2, 2 )
803 ELSE IF( NOTRNA .AND. .NOT.NOTRNB ) THEN
805 * Solve A*X + ISGN*X*B**T = scale*C.
807 * The (K,L)th block of X is determined starting from
808 * bottom-right corner column by column by
810 * A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
814 * R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
817 * Start column loop (index = L)
818 * L1 (L2): column index of the first (last) row of X(K,L)
828 IF( B( L, L-1 ).NE.ZERO ) THEN
839 * Start row loop (index = K)
840 * K1 (K2): row index of the first (last) row of X(K,L)
850 IF( A( K, K-1 ).NE.ZERO ) THEN
861 IF( L1.EQ.L2 .AND. K1.EQ.K2 ) THEN
862 SUML = SDOT( M-K1, A( K1, MIN(K1+1, M ) ), LDA,
863 $ C( MIN( K1+1, M ), L1 ), 1 )
864 SUMR = SDOT( N-L1, C( K1, MIN( L1+1, N ) ), LDC,
865 $ B( L1, MIN( L1+1, N ) ), LDB )
866 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
869 A11 = A( K1, K1 ) + SGN*B( L1, L1 )
871 IF( DA11.LE.SMIN ) THEN
876 DB = ABS( VEC( 1, 1 ) )
877 IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
878 IF( DB.GT.BIGNUM*DA11 )
881 X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
883 IF( SCALOC.NE.ONE ) THEN
885 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
889 C( K1, L1 ) = X( 1, 1 )
891 ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
893 SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
894 $ C( MIN( K2+1, M ), L1 ), 1 )
895 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
896 $ B( L1, MIN( L2+1, N ) ), LDB )
897 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
899 SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
900 $ C( MIN( K2+1, M ), L1 ), 1 )
901 SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
902 $ B( L1, MIN( L2+1, N ) ), LDB )
903 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
905 CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, A( K1, K1 ),
906 $ LDA, ONE, ONE, VEC, 2, -SGN*B( L1, L1 ),
907 $ ZERO, X, 2, SCALOC, XNORM, IERR )
911 IF( SCALOC.NE.ONE ) THEN
913 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
917 C( K1, L1 ) = X( 1, 1 )
918 C( K2, L1 ) = X( 2, 1 )
920 ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
922 SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
923 $ C( MIN( K1+1, M ), L1 ), 1 )
924 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
925 $ B( L1, MIN( L2+1, N ) ), LDB )
926 VEC( 1, 1 ) = SGN*( C( K1, L1 )-( SUML+SGN*SUMR ) )
928 SUML = SDOT( M-K1, A( K1, MIN( K1+1, M ) ), LDA,
929 $ C( MIN( K1+1, M ), L2 ), 1 )
930 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
931 $ B( L2, MIN( L2+1, N ) ), LDB )
932 VEC( 2, 1 ) = SGN*( C( K1, L2 )-( SUML+SGN*SUMR ) )
934 CALL SLALN2( .FALSE., 2, 1, SMIN, ONE, B( L1, L1 ),
935 $ LDB, ONE, ONE, VEC, 2, -SGN*A( K1, K1 ),
936 $ ZERO, X, 2, SCALOC, XNORM, IERR )
940 IF( SCALOC.NE.ONE ) THEN
942 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
946 C( K1, L1 ) = X( 1, 1 )
947 C( K1, L2 ) = X( 2, 1 )
949 ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
951 SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
952 $ C( MIN( K2+1, M ), L1 ), 1 )
953 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
954 $ B( L1, MIN( L2+1, N ) ), LDB )
955 VEC( 1, 1 ) = C( K1, L1 ) - ( SUML+SGN*SUMR )
957 SUML = SDOT( M-K2, A( K1, MIN( K2+1, M ) ), LDA,
958 $ C( MIN( K2+1, M ), L2 ), 1 )
959 SUMR = SDOT( N-L2, C( K1, MIN( L2+1, N ) ), LDC,
960 $ B( L2, MIN( L2+1, N ) ), LDB )
961 VEC( 1, 2 ) = C( K1, L2 ) - ( SUML+SGN*SUMR )
963 SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
964 $ C( MIN( K2+1, M ), L1 ), 1 )
965 SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
966 $ B( L1, MIN( L2+1, N ) ), LDB )
967 VEC( 2, 1 ) = C( K2, L1 ) - ( SUML+SGN*SUMR )
969 SUML = SDOT( M-K2, A( K2, MIN( K2+1, M ) ), LDA,
970 $ C( MIN( K2+1, M ), L2 ), 1 )
971 SUMR = SDOT( N-L2, C( K2, MIN( L2+1, N ) ), LDC,
972 $ B( L2, MIN( L2+1, N ) ), LDB )
973 VEC( 2, 2 ) = C( K2, L2 ) - ( SUML+SGN*SUMR )
975 CALL SLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
976 $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
981 IF( SCALOC.NE.ONE ) THEN
983 CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
987 C( K1, L1 ) = X( 1, 1 )
988 C( K1, L2 ) = X( 1, 2 )
989 C( K2, L1 ) = X( 2, 1 )
990 C( K2, L2 ) = X( 2, 2 )