You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

strsyl.f 36 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002
  1. *> \brief \b STRSYL
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download STRSYL + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/strsyl.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/strsyl.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/strsyl.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
  22. * LDC, SCALE, INFO )
  23. *
  24. * .. Scalar Arguments ..
  25. * CHARACTER TRANA, TRANB
  26. * INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
  27. * REAL SCALE
  28. * ..
  29. * .. Array Arguments ..
  30. * REAL A( LDA, * ), B( LDB, * ), C( LDC, * )
  31. * ..
  32. *
  33. *
  34. *> \par Purpose:
  35. * =============
  36. *>
  37. *> \verbatim
  38. *>
  39. *> STRSYL solves the real Sylvester matrix equation:
  40. *>
  41. *> op(A)*X + X*op(B) = scale*C or
  42. *> op(A)*X - X*op(B) = scale*C,
  43. *>
  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.
  48. *>
  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.
  53. *> \endverbatim
  54. *
  55. * Arguments:
  56. * ==========
  57. *
  58. *> \param[in] TRANA
  59. *> \verbatim
  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)
  65. *> \endverbatim
  66. *>
  67. *> \param[in] TRANB
  68. *> \verbatim
  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)
  74. *> \endverbatim
  75. *>
  76. *> \param[in] ISGN
  77. *> \verbatim
  78. *> ISGN is INTEGER
  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
  82. *> \endverbatim
  83. *>
  84. *> \param[in] M
  85. *> \verbatim
  86. *> M is INTEGER
  87. *> The order of the matrix A, and the number of rows in the
  88. *> matrices X and C. M >= 0.
  89. *> \endverbatim
  90. *>
  91. *> \param[in] N
  92. *> \verbatim
  93. *> N is INTEGER
  94. *> The order of the matrix B, and the number of columns in the
  95. *> matrices X and C. N >= 0.
  96. *> \endverbatim
  97. *>
  98. *> \param[in] A
  99. *> \verbatim
  100. *> A is REAL array, dimension (LDA,M)
  101. *> The upper quasi-triangular matrix A, in Schur canonical form.
  102. *> \endverbatim
  103. *>
  104. *> \param[in] LDA
  105. *> \verbatim
  106. *> LDA is INTEGER
  107. *> The leading dimension of the array A. LDA >= max(1,M).
  108. *> \endverbatim
  109. *>
  110. *> \param[in] B
  111. *> \verbatim
  112. *> B is REAL array, dimension (LDB,N)
  113. *> The upper quasi-triangular matrix B, in Schur canonical form.
  114. *> \endverbatim
  115. *>
  116. *> \param[in] LDB
  117. *> \verbatim
  118. *> LDB is INTEGER
  119. *> The leading dimension of the array B. LDB >= max(1,N).
  120. *> \endverbatim
  121. *>
  122. *> \param[in,out] C
  123. *> \verbatim
  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.
  127. *> \endverbatim
  128. *>
  129. *> \param[in] LDC
  130. *> \verbatim
  131. *> LDC is INTEGER
  132. *> The leading dimension of the array C. LDC >= max(1,M)
  133. *> \endverbatim
  134. *>
  135. *> \param[out] SCALE
  136. *> \verbatim
  137. *> SCALE is REAL
  138. *> The scale factor, scale, set <= 1 to avoid overflow in X.
  139. *> \endverbatim
  140. *>
  141. *> \param[out] INFO
  142. *> \verbatim
  143. *> INFO is INTEGER
  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).
  149. *> \endverbatim
  150. *
  151. * Authors:
  152. * ========
  153. *
  154. *> \author Univ. of Tennessee
  155. *> \author Univ. of California Berkeley
  156. *> \author Univ. of Colorado Denver
  157. *> \author NAG Ltd.
  158. *
  159. *> \date December 2016
  160. *
  161. *> \ingroup realSYcomputational
  162. *
  163. * =====================================================================
  164. SUBROUTINE STRSYL( TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C,
  165. $ LDC, SCALE, INFO )
  166. *
  167. * -- LAPACK computational routine (version 3.7.0) --
  168. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  169. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  170. * December 2016
  171. *
  172. * .. Scalar Arguments ..
  173. CHARACTER TRANA, TRANB
  174. INTEGER INFO, ISGN, LDA, LDB, LDC, M, N
  175. REAL SCALE
  176. * ..
  177. * .. Array Arguments ..
  178. REAL A( LDA, * ), B( LDB, * ), C( LDC, * )
  179. * ..
  180. *
  181. * =====================================================================
  182. *
  183. * .. Parameters ..
  184. REAL ZERO, ONE
  185. PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
  186. * ..
  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
  192. * ..
  193. * .. Local Arrays ..
  194. REAL DUM( 1 ), VEC( 2, 2 ), X( 2, 2 )
  195. * ..
  196. * .. External Functions ..
  197. LOGICAL LSAME
  198. REAL SDOT, SLAMCH, SLANGE
  199. EXTERNAL LSAME, SDOT, SLAMCH, SLANGE
  200. * ..
  201. * .. External Subroutines ..
  202. EXTERNAL SLABAD, SLALN2, SLASY2, SSCAL, XERBLA
  203. * ..
  204. * .. Intrinsic Functions ..
  205. INTRINSIC ABS, MAX, MIN, REAL
  206. * ..
  207. * .. Executable Statements ..
  208. *
  209. * Decode and Test input parameters
  210. *
  211. NOTRNA = LSAME( TRANA, 'N' )
  212. NOTRNB = LSAME( TRANB, 'N' )
  213. *
  214. INFO = 0
  215. IF( .NOT.NOTRNA .AND. .NOT.LSAME( TRANA, 'T' ) .AND. .NOT.
  216. $ LSAME( TRANA, 'C' ) ) THEN
  217. INFO = -1
  218. ELSE IF( .NOT.NOTRNB .AND. .NOT.LSAME( TRANB, 'T' ) .AND. .NOT.
  219. $ LSAME( TRANB, 'C' ) ) THEN
  220. INFO = -2
  221. ELSE IF( ISGN.NE.1 .AND. ISGN.NE.-1 ) THEN
  222. INFO = -3
  223. ELSE IF( M.LT.0 ) THEN
  224. INFO = -4
  225. ELSE IF( N.LT.0 ) THEN
  226. INFO = -5
  227. ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  228. INFO = -7
  229. ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
  230. INFO = -9
  231. ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
  232. INFO = -11
  233. END IF
  234. IF( INFO.NE.0 ) THEN
  235. CALL XERBLA( 'STRSYL', -INFO )
  236. RETURN
  237. END IF
  238. *
  239. * Quick return if possible
  240. *
  241. SCALE = ONE
  242. IF( M.EQ.0 .OR. N.EQ.0 )
  243. $ RETURN
  244. *
  245. * Set constants to control overflow
  246. *
  247. EPS = SLAMCH( 'P' )
  248. SMLNUM = SLAMCH( 'S' )
  249. BIGNUM = ONE / SMLNUM
  250. CALL SLABAD( SMLNUM, BIGNUM )
  251. SMLNUM = SMLNUM*REAL( M*N ) / EPS
  252. BIGNUM = ONE / SMLNUM
  253. *
  254. SMIN = MAX( SMLNUM, EPS*SLANGE( 'M', M, M, A, LDA, DUM ),
  255. $ EPS*SLANGE( 'M', N, N, B, LDB, DUM ) )
  256. *
  257. SGN = ISGN
  258. *
  259. IF( NOTRNA .AND. NOTRNB ) THEN
  260. *
  261. * Solve A*X + ISGN*X*B = scale*C.
  262. *
  263. * The (K,L)th block of X is determined starting from
  264. * bottom-left corner column by column by
  265. *
  266. * A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
  267. *
  268. * Where
  269. * M L-1
  270. * R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)].
  271. * I=K+1 J=1
  272. *
  273. * Start column loop (index = L)
  274. * L1 (L2) : column index of the first (first) row of X(K,L).
  275. *
  276. LNEXT = 1
  277. DO 70 L = 1, N
  278. IF( L.LT.LNEXT )
  279. $ GO TO 70
  280. IF( L.EQ.N ) THEN
  281. L1 = L
  282. L2 = L
  283. ELSE
  284. IF( B( L+1, L ).NE.ZERO ) THEN
  285. L1 = L
  286. L2 = L + 1
  287. LNEXT = L + 2
  288. ELSE
  289. L1 = L
  290. L2 = L
  291. LNEXT = L + 1
  292. END IF
  293. END IF
  294. *
  295. * Start row loop (index = K)
  296. * K1 (K2): row index of the first (last) row of X(K,L).
  297. *
  298. KNEXT = M
  299. DO 60 K = M, 1, -1
  300. IF( K.GT.KNEXT )
  301. $ GO TO 60
  302. IF( K.EQ.1 ) THEN
  303. K1 = K
  304. K2 = K
  305. ELSE
  306. IF( A( K, K-1 ).NE.ZERO ) THEN
  307. K1 = K - 1
  308. K2 = K
  309. KNEXT = K - 2
  310. ELSE
  311. K1 = K
  312. K2 = K
  313. KNEXT = K - 1
  314. END IF
  315. END IF
  316. *
  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 )
  322. SCALOC = ONE
  323. *
  324. A11 = A( K1, K1 ) + SGN*B( L1, L1 )
  325. DA11 = ABS( A11 )
  326. IF( DA11.LE.SMIN ) THEN
  327. A11 = SMIN
  328. DA11 = SMIN
  329. INFO = 1
  330. END IF
  331. DB = ABS( VEC( 1, 1 ) )
  332. IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
  333. IF( DB.GT.BIGNUM*DA11 )
  334. $ SCALOC = ONE / DB
  335. END IF
  336. X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
  337. *
  338. IF( SCALOC.NE.ONE ) THEN
  339. DO 10 J = 1, N
  340. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  341. 10 CONTINUE
  342. SCALE = SCALE*SCALOC
  343. END IF
  344. C( K1, L1 ) = X( 1, 1 )
  345. *
  346. ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
  347. *
  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 )
  352. *
  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 )
  357. *
  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 )
  361. IF( IERR.NE.0 )
  362. $ INFO = 1
  363. *
  364. IF( SCALOC.NE.ONE ) THEN
  365. DO 20 J = 1, N
  366. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  367. 20 CONTINUE
  368. SCALE = SCALE*SCALOC
  369. END IF
  370. C( K1, L1 ) = X( 1, 1 )
  371. C( K2, L1 ) = X( 2, 1 )
  372. *
  373. ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
  374. *
  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 ) )
  379. *
  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 ) )
  384. *
  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 )
  388. IF( IERR.NE.0 )
  389. $ INFO = 1
  390. *
  391. IF( SCALOC.NE.ONE ) THEN
  392. DO 40 J = 1, N
  393. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  394. 40 CONTINUE
  395. SCALE = SCALE*SCALOC
  396. END IF
  397. C( K1, L1 ) = X( 1, 1 )
  398. C( K1, L2 ) = X( 2, 1 )
  399. *
  400. ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
  401. *
  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 )
  406. *
  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 )
  411. *
  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 )
  416. *
  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 )
  421. *
  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 )
  425. IF( IERR.NE.0 )
  426. $ INFO = 1
  427. *
  428. IF( SCALOC.NE.ONE ) THEN
  429. DO 50 J = 1, N
  430. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  431. 50 CONTINUE
  432. SCALE = SCALE*SCALOC
  433. END IF
  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 )
  438. END IF
  439. *
  440. 60 CONTINUE
  441. *
  442. 70 CONTINUE
  443. *
  444. ELSE IF( .NOT.NOTRNA .AND. NOTRNB ) THEN
  445. *
  446. * Solve A**T *X + ISGN*X*B = scale*C.
  447. *
  448. * The (K,L)th block of X is determined starting from
  449. * upper-left corner column by column by
  450. *
  451. * A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L)
  452. *
  453. * Where
  454. * K-1 L-1
  455. * R(K,L) = SUM [A(I,K)**T*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)]
  456. * I=1 J=1
  457. *
  458. * Start column loop (index = L)
  459. * L1 (L2): column index of the first (last) row of X(K,L)
  460. *
  461. LNEXT = 1
  462. DO 130 L = 1, N
  463. IF( L.LT.LNEXT )
  464. $ GO TO 130
  465. IF( L.EQ.N ) THEN
  466. L1 = L
  467. L2 = L
  468. ELSE
  469. IF( B( L+1, L ).NE.ZERO ) THEN
  470. L1 = L
  471. L2 = L + 1
  472. LNEXT = L + 2
  473. ELSE
  474. L1 = L
  475. L2 = L
  476. LNEXT = L + 1
  477. END IF
  478. END IF
  479. *
  480. * Start row loop (index = K)
  481. * K1 (K2): row index of the first (last) row of X(K,L)
  482. *
  483. KNEXT = 1
  484. DO 120 K = 1, M
  485. IF( K.LT.KNEXT )
  486. $ GO TO 120
  487. IF( K.EQ.M ) THEN
  488. K1 = K
  489. K2 = K
  490. ELSE
  491. IF( A( K+1, K ).NE.ZERO ) THEN
  492. K1 = K
  493. K2 = K + 1
  494. KNEXT = K + 2
  495. ELSE
  496. K1 = K
  497. K2 = K
  498. KNEXT = K + 1
  499. END IF
  500. END IF
  501. *
  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 )
  506. SCALOC = ONE
  507. *
  508. A11 = A( K1, K1 ) + SGN*B( L1, L1 )
  509. DA11 = ABS( A11 )
  510. IF( DA11.LE.SMIN ) THEN
  511. A11 = SMIN
  512. DA11 = SMIN
  513. INFO = 1
  514. END IF
  515. DB = ABS( VEC( 1, 1 ) )
  516. IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
  517. IF( DB.GT.BIGNUM*DA11 )
  518. $ SCALOC = ONE / DB
  519. END IF
  520. X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
  521. *
  522. IF( SCALOC.NE.ONE ) THEN
  523. DO 80 J = 1, N
  524. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  525. 80 CONTINUE
  526. SCALE = SCALE*SCALOC
  527. END IF
  528. C( K1, L1 ) = X( 1, 1 )
  529. *
  530. ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
  531. *
  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 )
  535. *
  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 )
  539. *
  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 )
  543. IF( IERR.NE.0 )
  544. $ INFO = 1
  545. *
  546. IF( SCALOC.NE.ONE ) THEN
  547. DO 90 J = 1, N
  548. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  549. 90 CONTINUE
  550. SCALE = SCALE*SCALOC
  551. END IF
  552. C( K1, L1 ) = X( 1, 1 )
  553. C( K2, L1 ) = X( 2, 1 )
  554. *
  555. ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
  556. *
  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 ) )
  560. *
  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 ) )
  564. *
  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 )
  568. IF( IERR.NE.0 )
  569. $ INFO = 1
  570. *
  571. IF( SCALOC.NE.ONE ) THEN
  572. DO 100 J = 1, N
  573. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  574. 100 CONTINUE
  575. SCALE = SCALE*SCALOC
  576. END IF
  577. C( K1, L1 ) = X( 1, 1 )
  578. C( K1, L2 ) = X( 2, 1 )
  579. *
  580. ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
  581. *
  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 )
  585. *
  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 )
  589. *
  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 )
  593. *
  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 )
  597. *
  598. CALL SLASY2( .TRUE., .FALSE., ISGN, 2, 2, A( K1, K1 ),
  599. $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
  600. $ 2, XNORM, IERR )
  601. IF( IERR.NE.0 )
  602. $ INFO = 1
  603. *
  604. IF( SCALOC.NE.ONE ) THEN
  605. DO 110 J = 1, N
  606. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  607. 110 CONTINUE
  608. SCALE = SCALE*SCALOC
  609. END IF
  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 )
  614. END IF
  615. *
  616. 120 CONTINUE
  617. 130 CONTINUE
  618. *
  619. ELSE IF( .NOT.NOTRNA .AND. .NOT.NOTRNB ) THEN
  620. *
  621. * Solve A**T*X + ISGN*X*B**T = scale*C.
  622. *
  623. * The (K,L)th block of X is determined starting from
  624. * top-right corner column by column by
  625. *
  626. * A(K,K)**T*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
  627. *
  628. * Where
  629. * K-1 N
  630. * R(K,L) = SUM [A(I,K)**T*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
  631. * I=1 J=L+1
  632. *
  633. * Start column loop (index = L)
  634. * L1 (L2): column index of the first (last) row of X(K,L)
  635. *
  636. LNEXT = N
  637. DO 190 L = N, 1, -1
  638. IF( L.GT.LNEXT )
  639. $ GO TO 190
  640. IF( L.EQ.1 ) THEN
  641. L1 = L
  642. L2 = L
  643. ELSE
  644. IF( B( L, L-1 ).NE.ZERO ) THEN
  645. L1 = L - 1
  646. L2 = L
  647. LNEXT = L - 2
  648. ELSE
  649. L1 = L
  650. L2 = L
  651. LNEXT = L - 1
  652. END IF
  653. END IF
  654. *
  655. * Start row loop (index = K)
  656. * K1 (K2): row index of the first (last) row of X(K,L)
  657. *
  658. KNEXT = 1
  659. DO 180 K = 1, M
  660. IF( K.LT.KNEXT )
  661. $ GO TO 180
  662. IF( K.EQ.M ) THEN
  663. K1 = K
  664. K2 = K
  665. ELSE
  666. IF( A( K+1, K ).NE.ZERO ) THEN
  667. K1 = K
  668. K2 = K + 1
  669. KNEXT = K + 2
  670. ELSE
  671. K1 = K
  672. K2 = K
  673. KNEXT = K + 1
  674. END IF
  675. END IF
  676. *
  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 )
  682. SCALOC = ONE
  683. *
  684. A11 = A( K1, K1 ) + SGN*B( L1, L1 )
  685. DA11 = ABS( A11 )
  686. IF( DA11.LE.SMIN ) THEN
  687. A11 = SMIN
  688. DA11 = SMIN
  689. INFO = 1
  690. END IF
  691. DB = ABS( VEC( 1, 1 ) )
  692. IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
  693. IF( DB.GT.BIGNUM*DA11 )
  694. $ SCALOC = ONE / DB
  695. END IF
  696. X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
  697. *
  698. IF( SCALOC.NE.ONE ) THEN
  699. DO 140 J = 1, N
  700. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  701. 140 CONTINUE
  702. SCALE = SCALE*SCALOC
  703. END IF
  704. C( K1, L1 ) = X( 1, 1 )
  705. *
  706. ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
  707. *
  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 )
  712. *
  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 )
  717. *
  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 )
  721. IF( IERR.NE.0 )
  722. $ INFO = 1
  723. *
  724. IF( SCALOC.NE.ONE ) THEN
  725. DO 150 J = 1, N
  726. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  727. 150 CONTINUE
  728. SCALE = SCALE*SCALOC
  729. END IF
  730. C( K1, L1 ) = X( 1, 1 )
  731. C( K2, L1 ) = X( 2, 1 )
  732. *
  733. ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
  734. *
  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 ) )
  739. *
  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 ) )
  744. *
  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 )
  748. IF( IERR.NE.0 )
  749. $ INFO = 1
  750. *
  751. IF( SCALOC.NE.ONE ) THEN
  752. DO 160 J = 1, N
  753. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  754. 160 CONTINUE
  755. SCALE = SCALE*SCALOC
  756. END IF
  757. C( K1, L1 ) = X( 1, 1 )
  758. C( K1, L2 ) = X( 2, 1 )
  759. *
  760. ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
  761. *
  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 )
  766. *
  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 )
  771. *
  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 )
  776. *
  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 )
  781. *
  782. CALL SLASY2( .TRUE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
  783. $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
  784. $ 2, XNORM, IERR )
  785. IF( IERR.NE.0 )
  786. $ INFO = 1
  787. *
  788. IF( SCALOC.NE.ONE ) THEN
  789. DO 170 J = 1, N
  790. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  791. 170 CONTINUE
  792. SCALE = SCALE*SCALOC
  793. END IF
  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 )
  798. END IF
  799. *
  800. 180 CONTINUE
  801. 190 CONTINUE
  802. *
  803. ELSE IF( NOTRNA .AND. .NOT.NOTRNB ) THEN
  804. *
  805. * Solve A*X + ISGN*X*B**T = scale*C.
  806. *
  807. * The (K,L)th block of X is determined starting from
  808. * bottom-right corner column by column by
  809. *
  810. * A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L)**T = C(K,L) - R(K,L)
  811. *
  812. * Where
  813. * M N
  814. * R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)**T].
  815. * I=K+1 J=L+1
  816. *
  817. * Start column loop (index = L)
  818. * L1 (L2): column index of the first (last) row of X(K,L)
  819. *
  820. LNEXT = N
  821. DO 250 L = N, 1, -1
  822. IF( L.GT.LNEXT )
  823. $ GO TO 250
  824. IF( L.EQ.1 ) THEN
  825. L1 = L
  826. L2 = L
  827. ELSE
  828. IF( B( L, L-1 ).NE.ZERO ) THEN
  829. L1 = L - 1
  830. L2 = L
  831. LNEXT = L - 2
  832. ELSE
  833. L1 = L
  834. L2 = L
  835. LNEXT = L - 1
  836. END IF
  837. END IF
  838. *
  839. * Start row loop (index = K)
  840. * K1 (K2): row index of the first (last) row of X(K,L)
  841. *
  842. KNEXT = M
  843. DO 240 K = M, 1, -1
  844. IF( K.GT.KNEXT )
  845. $ GO TO 240
  846. IF( K.EQ.1 ) THEN
  847. K1 = K
  848. K2 = K
  849. ELSE
  850. IF( A( K, K-1 ).NE.ZERO ) THEN
  851. K1 = K - 1
  852. K2 = K
  853. KNEXT = K - 2
  854. ELSE
  855. K1 = K
  856. K2 = K
  857. KNEXT = K - 1
  858. END IF
  859. END IF
  860. *
  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 )
  867. SCALOC = ONE
  868. *
  869. A11 = A( K1, K1 ) + SGN*B( L1, L1 )
  870. DA11 = ABS( A11 )
  871. IF( DA11.LE.SMIN ) THEN
  872. A11 = SMIN
  873. DA11 = SMIN
  874. INFO = 1
  875. END IF
  876. DB = ABS( VEC( 1, 1 ) )
  877. IF( DA11.LT.ONE .AND. DB.GT.ONE ) THEN
  878. IF( DB.GT.BIGNUM*DA11 )
  879. $ SCALOC = ONE / DB
  880. END IF
  881. X( 1, 1 ) = ( VEC( 1, 1 )*SCALOC ) / A11
  882. *
  883. IF( SCALOC.NE.ONE ) THEN
  884. DO 200 J = 1, N
  885. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  886. 200 CONTINUE
  887. SCALE = SCALE*SCALOC
  888. END IF
  889. C( K1, L1 ) = X( 1, 1 )
  890. *
  891. ELSE IF( L1.EQ.L2 .AND. K1.NE.K2 ) THEN
  892. *
  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 )
  898. *
  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 )
  904. *
  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 )
  908. IF( IERR.NE.0 )
  909. $ INFO = 1
  910. *
  911. IF( SCALOC.NE.ONE ) THEN
  912. DO 210 J = 1, N
  913. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  914. 210 CONTINUE
  915. SCALE = SCALE*SCALOC
  916. END IF
  917. C( K1, L1 ) = X( 1, 1 )
  918. C( K2, L1 ) = X( 2, 1 )
  919. *
  920. ELSE IF( L1.NE.L2 .AND. K1.EQ.K2 ) THEN
  921. *
  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 ) )
  927. *
  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 ) )
  933. *
  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 )
  937. IF( IERR.NE.0 )
  938. $ INFO = 1
  939. *
  940. IF( SCALOC.NE.ONE ) THEN
  941. DO 220 J = 1, N
  942. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  943. 220 CONTINUE
  944. SCALE = SCALE*SCALOC
  945. END IF
  946. C( K1, L1 ) = X( 1, 1 )
  947. C( K1, L2 ) = X( 2, 1 )
  948. *
  949. ELSE IF( L1.NE.L2 .AND. K1.NE.K2 ) THEN
  950. *
  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 )
  956. *
  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 )
  962. *
  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 )
  968. *
  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 )
  974. *
  975. CALL SLASY2( .FALSE., .TRUE., ISGN, 2, 2, A( K1, K1 ),
  976. $ LDA, B( L1, L1 ), LDB, VEC, 2, SCALOC, X,
  977. $ 2, XNORM, IERR )
  978. IF( IERR.NE.0 )
  979. $ INFO = 1
  980. *
  981. IF( SCALOC.NE.ONE ) THEN
  982. DO 230 J = 1, N
  983. CALL SSCAL( M, SCALOC, C( 1, J ), 1 )
  984. 230 CONTINUE
  985. SCALE = SCALE*SCALOC
  986. END IF
  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 )
  991. END IF
  992. *
  993. 240 CONTINUE
  994. 250 CONTINUE
  995. *
  996. END IF
  997. *
  998. RETURN
  999. *
  1000. * End of STRSYL
  1001. *
  1002. END