dtrsyl.c 36 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320
  1. /* dtrsyl.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. /* Table of constant values */
  14. static integer c__1 = 1;
  15. static logical c_false = FALSE_;
  16. static integer c__2 = 2;
  17. static doublereal c_b26 = 1.;
  18. static doublereal c_b30 = 0.;
  19. static logical c_true = TRUE_;
  20. /* Subroutine */ int _starpu_dtrsyl_(char *trana, char *tranb, integer *isgn, integer
  21. *m, integer *n, doublereal *a, integer *lda, doublereal *b, integer *
  22. ldb, doublereal *c__, integer *ldc, doublereal *scale, integer *info)
  23. {
  24. /* System generated locals */
  25. integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
  26. i__3, i__4;
  27. doublereal d__1, d__2;
  28. /* Local variables */
  29. integer j, k, l;
  30. doublereal x[4] /* was [2][2] */;
  31. integer k1, k2, l1, l2;
  32. doublereal a11, db, da11, vec[4] /* was [2][2] */, dum[1], eps, sgn;
  33. extern doublereal _starpu_ddot_(integer *, doublereal *, integer *, doublereal *,
  34. integer *);
  35. integer ierr;
  36. doublereal smin, suml, sumr;
  37. extern /* Subroutine */ int _starpu_dscal_(integer *, doublereal *, doublereal *,
  38. integer *);
  39. extern logical _starpu_lsame_(char *, char *);
  40. integer knext, lnext;
  41. doublereal xnorm;
  42. extern /* Subroutine */ int _starpu_dlaln2_(logical *, integer *, integer *,
  43. doublereal *, doublereal *, doublereal *, integer *, doublereal *,
  44. doublereal *, doublereal *, integer *, doublereal *, doublereal *
  45. , doublereal *, integer *, doublereal *, doublereal *, integer *),
  46. _starpu_dlasy2_(logical *, logical *, integer *, integer *, integer *,
  47. doublereal *, integer *, doublereal *, integer *, doublereal *,
  48. integer *, doublereal *, doublereal *, integer *, doublereal *,
  49. integer *), _starpu_dlabad_(doublereal *, doublereal *);
  50. extern doublereal _starpu_dlamch_(char *), _starpu_dlange_(char *, integer *,
  51. integer *, doublereal *, integer *, doublereal *);
  52. doublereal scaloc;
  53. extern /* Subroutine */ int _starpu_xerbla_(char *, integer *);
  54. doublereal bignum;
  55. logical notrna, notrnb;
  56. doublereal smlnum;
  57. /* -- LAPACK routine (version 3.2) -- */
  58. /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
  59. /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
  60. /* November 2006 */
  61. /* .. Scalar Arguments .. */
  62. /* .. */
  63. /* .. Array Arguments .. */
  64. /* .. */
  65. /* Purpose */
  66. /* ======= */
  67. /* DTRSYL solves the real Sylvester matrix equation: */
  68. /* op(A)*X + X*op(B) = scale*C or */
  69. /* op(A)*X - X*op(B) = scale*C, */
  70. /* where op(A) = A or A**T, and A and B are both upper quasi- */
  71. /* triangular. A is M-by-M and B is N-by-N; the right hand side C and */
  72. /* the solution X are M-by-N; and scale is an output scale factor, set */
  73. /* <= 1 to avoid overflow in X. */
  74. /* A and B must be in Schur canonical form (as returned by DHSEQR), that */
  75. /* is, block upper triangular with 1-by-1 and 2-by-2 diagonal blocks; */
  76. /* each 2-by-2 diagonal block has its diagonal elements equal and its */
  77. /* off-diagonal elements of opposite sign. */
  78. /* Arguments */
  79. /* ========= */
  80. /* TRANA (input) CHARACTER*1 */
  81. /* Specifies the option op(A): */
  82. /* = 'N': op(A) = A (No transpose) */
  83. /* = 'T': op(A) = A**T (Transpose) */
  84. /* = 'C': op(A) = A**H (Conjugate transpose = Transpose) */
  85. /* TRANB (input) CHARACTER*1 */
  86. /* Specifies the option op(B): */
  87. /* = 'N': op(B) = B (No transpose) */
  88. /* = 'T': op(B) = B**T (Transpose) */
  89. /* = 'C': op(B) = B**H (Conjugate transpose = Transpose) */
  90. /* ISGN (input) INTEGER */
  91. /* Specifies the sign in the equation: */
  92. /* = +1: solve op(A)*X + X*op(B) = scale*C */
  93. /* = -1: solve op(A)*X - X*op(B) = scale*C */
  94. /* M (input) INTEGER */
  95. /* The order of the matrix A, and the number of rows in the */
  96. /* matrices X and C. M >= 0. */
  97. /* N (input) INTEGER */
  98. /* The order of the matrix B, and the number of columns in the */
  99. /* matrices X and C. N >= 0. */
  100. /* A (input) DOUBLE PRECISION array, dimension (LDA,M) */
  101. /* The upper quasi-triangular matrix A, in Schur canonical form. */
  102. /* LDA (input) INTEGER */
  103. /* The leading dimension of the array A. LDA >= max(1,M). */
  104. /* B (input) DOUBLE PRECISION array, dimension (LDB,N) */
  105. /* The upper quasi-triangular matrix B, in Schur canonical form. */
  106. /* LDB (input) INTEGER */
  107. /* The leading dimension of the array B. LDB >= max(1,N). */
  108. /* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
  109. /* On entry, the M-by-N right hand side matrix C. */
  110. /* On exit, C is overwritten by the solution matrix X. */
  111. /* LDC (input) INTEGER */
  112. /* The leading dimension of the array C. LDC >= max(1,M) */
  113. /* SCALE (output) DOUBLE PRECISION */
  114. /* The scale factor, scale, set <= 1 to avoid overflow in X. */
  115. /* INFO (output) INTEGER */
  116. /* = 0: successful exit */
  117. /* < 0: if INFO = -i, the i-th argument had an illegal value */
  118. /* = 1: A and B have common or very close eigenvalues; perturbed */
  119. /* values were used to solve the equation (but the matrices */
  120. /* A and B are unchanged). */
  121. /* ===================================================================== */
  122. /* .. Parameters .. */
  123. /* .. */
  124. /* .. Local Scalars .. */
  125. /* .. */
  126. /* .. Local Arrays .. */
  127. /* .. */
  128. /* .. External Functions .. */
  129. /* .. */
  130. /* .. External Subroutines .. */
  131. /* .. */
  132. /* .. Intrinsic Functions .. */
  133. /* .. */
  134. /* .. Executable Statements .. */
  135. /* Decode and Test input parameters */
  136. /* Parameter adjustments */
  137. a_dim1 = *lda;
  138. a_offset = 1 + a_dim1;
  139. a -= a_offset;
  140. b_dim1 = *ldb;
  141. b_offset = 1 + b_dim1;
  142. b -= b_offset;
  143. c_dim1 = *ldc;
  144. c_offset = 1 + c_dim1;
  145. c__ -= c_offset;
  146. /* Function Body */
  147. notrna = _starpu_lsame_(trana, "N");
  148. notrnb = _starpu_lsame_(tranb, "N");
  149. *info = 0;
  150. if (! notrna && ! _starpu_lsame_(trana, "T") && ! _starpu_lsame_(
  151. trana, "C")) {
  152. *info = -1;
  153. } else if (! notrnb && ! _starpu_lsame_(tranb, "T") && !
  154. _starpu_lsame_(tranb, "C")) {
  155. *info = -2;
  156. } else if (*isgn != 1 && *isgn != -1) {
  157. *info = -3;
  158. } else if (*m < 0) {
  159. *info = -4;
  160. } else if (*n < 0) {
  161. *info = -5;
  162. } else if (*lda < max(1,*m)) {
  163. *info = -7;
  164. } else if (*ldb < max(1,*n)) {
  165. *info = -9;
  166. } else if (*ldc < max(1,*m)) {
  167. *info = -11;
  168. }
  169. if (*info != 0) {
  170. i__1 = -(*info);
  171. _starpu_xerbla_("DTRSYL", &i__1);
  172. return 0;
  173. }
  174. /* Quick return if possible */
  175. *scale = 1.;
  176. if (*m == 0 || *n == 0) {
  177. return 0;
  178. }
  179. /* Set constants to control overflow */
  180. eps = _starpu_dlamch_("P");
  181. smlnum = _starpu_dlamch_("S");
  182. bignum = 1. / smlnum;
  183. _starpu_dlabad_(&smlnum, &bignum);
  184. smlnum = smlnum * (doublereal) (*m * *n) / eps;
  185. bignum = 1. / smlnum;
  186. /* Computing MAX */
  187. d__1 = smlnum, d__2 = eps * _starpu_dlange_("M", m, m, &a[a_offset], lda, dum), d__1 = max(d__1,d__2), d__2 = eps * _starpu_dlange_("M", n, n,
  188. &b[b_offset], ldb, dum);
  189. smin = max(d__1,d__2);
  190. sgn = (doublereal) (*isgn);
  191. if (notrna && notrnb) {
  192. /* Solve A*X + ISGN*X*B = scale*C. */
  193. /* The (K,L)th block of X is determined starting from */
  194. /* bottom-left corner column by column by */
  195. /* A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L) */
  196. /* Where */
  197. /* M L-1 */
  198. /* R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(J,L)]. */
  199. /* I=K+1 J=1 */
  200. /* Start column loop (index = L) */
  201. /* L1 (L2) : column index of the first (first) row of X(K,L). */
  202. lnext = 1;
  203. i__1 = *n;
  204. for (l = 1; l <= i__1; ++l) {
  205. if (l < lnext) {
  206. goto L60;
  207. }
  208. if (l == *n) {
  209. l1 = l;
  210. l2 = l;
  211. } else {
  212. if (b[l + 1 + l * b_dim1] != 0.) {
  213. l1 = l;
  214. l2 = l + 1;
  215. lnext = l + 2;
  216. } else {
  217. l1 = l;
  218. l2 = l;
  219. lnext = l + 1;
  220. }
  221. }
  222. /* Start row loop (index = K) */
  223. /* K1 (K2): row index of the first (last) row of X(K,L). */
  224. knext = *m;
  225. for (k = *m; k >= 1; --k) {
  226. if (k > knext) {
  227. goto L50;
  228. }
  229. if (k == 1) {
  230. k1 = k;
  231. k2 = k;
  232. } else {
  233. if (a[k + (k - 1) * a_dim1] != 0.) {
  234. k1 = k - 1;
  235. k2 = k;
  236. knext = k - 2;
  237. } else {
  238. k1 = k;
  239. k2 = k;
  240. knext = k - 1;
  241. }
  242. }
  243. if (l1 == l2 && k1 == k2) {
  244. i__2 = *m - k1;
  245. /* Computing MIN */
  246. i__3 = k1 + 1;
  247. /* Computing MIN */
  248. i__4 = k1 + 1;
  249. suml = _starpu_ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
  250. c__[min(i__4, *m)+ l1 * c_dim1], &c__1);
  251. i__2 = l1 - 1;
  252. sumr = _starpu_ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 *
  253. b_dim1 + 1], &c__1);
  254. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  255. scaloc = 1.;
  256. a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
  257. da11 = abs(a11);
  258. if (da11 <= smin) {
  259. a11 = smin;
  260. da11 = smin;
  261. *info = 1;
  262. }
  263. db = abs(vec[0]);
  264. if (da11 < 1. && db > 1.) {
  265. if (db > bignum * da11) {
  266. scaloc = 1. / db;
  267. }
  268. }
  269. x[0] = vec[0] * scaloc / a11;
  270. if (scaloc != 1.) {
  271. i__2 = *n;
  272. for (j = 1; j <= i__2; ++j) {
  273. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  274. /* L10: */
  275. }
  276. *scale *= scaloc;
  277. }
  278. c__[k1 + l1 * c_dim1] = x[0];
  279. } else if (l1 == l2 && k1 != k2) {
  280. i__2 = *m - k2;
  281. /* Computing MIN */
  282. i__3 = k2 + 1;
  283. /* Computing MIN */
  284. i__4 = k2 + 1;
  285. suml = _starpu_ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
  286. c__[min(i__4, *m)+ l1 * c_dim1], &c__1);
  287. i__2 = l1 - 1;
  288. sumr = _starpu_ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 *
  289. b_dim1 + 1], &c__1);
  290. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  291. i__2 = *m - k2;
  292. /* Computing MIN */
  293. i__3 = k2 + 1;
  294. /* Computing MIN */
  295. i__4 = k2 + 1;
  296. suml = _starpu_ddot_(&i__2, &a[k2 + min(i__3, *m)* a_dim1], lda, &
  297. c__[min(i__4, *m)+ l1 * c_dim1], &c__1);
  298. i__2 = l1 - 1;
  299. sumr = _starpu_ddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l1 *
  300. b_dim1 + 1], &c__1);
  301. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  302. d__1 = -sgn * b[l1 + l1 * b_dim1];
  303. _starpu_dlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1
  304. * a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1,
  305. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  306. if (ierr != 0) {
  307. *info = 1;
  308. }
  309. if (scaloc != 1.) {
  310. i__2 = *n;
  311. for (j = 1; j <= i__2; ++j) {
  312. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  313. /* L20: */
  314. }
  315. *scale *= scaloc;
  316. }
  317. c__[k1 + l1 * c_dim1] = x[0];
  318. c__[k2 + l1 * c_dim1] = x[1];
  319. } else if (l1 != l2 && k1 == k2) {
  320. i__2 = *m - k1;
  321. /* Computing MIN */
  322. i__3 = k1 + 1;
  323. /* Computing MIN */
  324. i__4 = k1 + 1;
  325. suml = _starpu_ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
  326. c__[min(i__4, *m)+ l1 * c_dim1], &c__1);
  327. i__2 = l1 - 1;
  328. sumr = _starpu_ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 *
  329. b_dim1 + 1], &c__1);
  330. vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn *
  331. sumr));
  332. i__2 = *m - k1;
  333. /* Computing MIN */
  334. i__3 = k1 + 1;
  335. /* Computing MIN */
  336. i__4 = k1 + 1;
  337. suml = _starpu_ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
  338. c__[min(i__4, *m)+ l2 * c_dim1], &c__1);
  339. i__2 = l1 - 1;
  340. sumr = _starpu_ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l2 *
  341. b_dim1 + 1], &c__1);
  342. vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn *
  343. sumr));
  344. d__1 = -sgn * a[k1 + k1 * a_dim1];
  345. _starpu_dlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1 *
  346. b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1,
  347. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  348. if (ierr != 0) {
  349. *info = 1;
  350. }
  351. if (scaloc != 1.) {
  352. i__2 = *n;
  353. for (j = 1; j <= i__2; ++j) {
  354. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  355. /* L30: */
  356. }
  357. *scale *= scaloc;
  358. }
  359. c__[k1 + l1 * c_dim1] = x[0];
  360. c__[k1 + l2 * c_dim1] = x[1];
  361. } else if (l1 != l2 && k1 != k2) {
  362. i__2 = *m - k2;
  363. /* Computing MIN */
  364. i__3 = k2 + 1;
  365. /* Computing MIN */
  366. i__4 = k2 + 1;
  367. suml = _starpu_ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
  368. c__[min(i__4, *m)+ l1 * c_dim1], &c__1);
  369. i__2 = l1 - 1;
  370. sumr = _starpu_ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l1 *
  371. b_dim1 + 1], &c__1);
  372. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  373. i__2 = *m - k2;
  374. /* Computing MIN */
  375. i__3 = k2 + 1;
  376. /* Computing MIN */
  377. i__4 = k2 + 1;
  378. suml = _starpu_ddot_(&i__2, &a[k1 + min(i__3, *m)* a_dim1], lda, &
  379. c__[min(i__4, *m)+ l2 * c_dim1], &c__1);
  380. i__2 = l1 - 1;
  381. sumr = _starpu_ddot_(&i__2, &c__[k1 + c_dim1], ldc, &b[l2 *
  382. b_dim1 + 1], &c__1);
  383. vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);
  384. i__2 = *m - k2;
  385. /* Computing MIN */
  386. i__3 = k2 + 1;
  387. /* Computing MIN */
  388. i__4 = k2 + 1;
  389. suml = _starpu_ddot_(&i__2, &a[k2 + min(i__3, *m)* a_dim1], lda, &
  390. c__[min(i__4, *m)+ l1 * c_dim1], &c__1);
  391. i__2 = l1 - 1;
  392. sumr = _starpu_ddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l1 *
  393. b_dim1 + 1], &c__1);
  394. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  395. i__2 = *m - k2;
  396. /* Computing MIN */
  397. i__3 = k2 + 1;
  398. /* Computing MIN */
  399. i__4 = k2 + 1;
  400. suml = _starpu_ddot_(&i__2, &a[k2 + min(i__3, *m)* a_dim1], lda, &
  401. c__[min(i__4, *m)+ l2 * c_dim1], &c__1);
  402. i__2 = l1 - 1;
  403. sumr = _starpu_ddot_(&i__2, &c__[k2 + c_dim1], ldc, &b[l2 *
  404. b_dim1 + 1], &c__1);
  405. vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);
  406. _starpu_dlasy2_(&c_false, &c_false, isgn, &c__2, &c__2, &a[k1 +
  407. k1 * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec,
  408. &c__2, &scaloc, x, &c__2, &xnorm, &ierr);
  409. if (ierr != 0) {
  410. *info = 1;
  411. }
  412. if (scaloc != 1.) {
  413. i__2 = *n;
  414. for (j = 1; j <= i__2; ++j) {
  415. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  416. /* L40: */
  417. }
  418. *scale *= scaloc;
  419. }
  420. c__[k1 + l1 * c_dim1] = x[0];
  421. c__[k1 + l2 * c_dim1] = x[2];
  422. c__[k2 + l1 * c_dim1] = x[1];
  423. c__[k2 + l2 * c_dim1] = x[3];
  424. }
  425. L50:
  426. ;
  427. }
  428. L60:
  429. ;
  430. }
  431. } else if (! notrna && notrnb) {
  432. /* Solve A' *X + ISGN*X*B = scale*C. */
  433. /* The (K,L)th block of X is determined starting from */
  434. /* upper-left corner column by column by */
  435. /* A(K,K)'*X(K,L) + ISGN*X(K,L)*B(L,L) = C(K,L) - R(K,L) */
  436. /* Where */
  437. /* K-1 L-1 */
  438. /* R(K,L) = SUM [A(I,K)'*X(I,L)] +ISGN*SUM [X(K,J)*B(J,L)] */
  439. /* I=1 J=1 */
  440. /* Start column loop (index = L) */
  441. /* L1 (L2): column index of the first (last) row of X(K,L) */
  442. lnext = 1;
  443. i__1 = *n;
  444. for (l = 1; l <= i__1; ++l) {
  445. if (l < lnext) {
  446. goto L120;
  447. }
  448. if (l == *n) {
  449. l1 = l;
  450. l2 = l;
  451. } else {
  452. if (b[l + 1 + l * b_dim1] != 0.) {
  453. l1 = l;
  454. l2 = l + 1;
  455. lnext = l + 2;
  456. } else {
  457. l1 = l;
  458. l2 = l;
  459. lnext = l + 1;
  460. }
  461. }
  462. /* Start row loop (index = K) */
  463. /* K1 (K2): row index of the first (last) row of X(K,L) */
  464. knext = 1;
  465. i__2 = *m;
  466. for (k = 1; k <= i__2; ++k) {
  467. if (k < knext) {
  468. goto L110;
  469. }
  470. if (k == *m) {
  471. k1 = k;
  472. k2 = k;
  473. } else {
  474. if (a[k + 1 + k * a_dim1] != 0.) {
  475. k1 = k;
  476. k2 = k + 1;
  477. knext = k + 2;
  478. } else {
  479. k1 = k;
  480. k2 = k;
  481. knext = k + 1;
  482. }
  483. }
  484. if (l1 == l2 && k1 == k2) {
  485. i__3 = k1 - 1;
  486. suml = _starpu_ddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  487. c_dim1 + 1], &c__1);
  488. i__3 = l1 - 1;
  489. sumr = _starpu_ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 *
  490. b_dim1 + 1], &c__1);
  491. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  492. scaloc = 1.;
  493. a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
  494. da11 = abs(a11);
  495. if (da11 <= smin) {
  496. a11 = smin;
  497. da11 = smin;
  498. *info = 1;
  499. }
  500. db = abs(vec[0]);
  501. if (da11 < 1. && db > 1.) {
  502. if (db > bignum * da11) {
  503. scaloc = 1. / db;
  504. }
  505. }
  506. x[0] = vec[0] * scaloc / a11;
  507. if (scaloc != 1.) {
  508. i__3 = *n;
  509. for (j = 1; j <= i__3; ++j) {
  510. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  511. /* L70: */
  512. }
  513. *scale *= scaloc;
  514. }
  515. c__[k1 + l1 * c_dim1] = x[0];
  516. } else if (l1 == l2 && k1 != k2) {
  517. i__3 = k1 - 1;
  518. suml = _starpu_ddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  519. c_dim1 + 1], &c__1);
  520. i__3 = l1 - 1;
  521. sumr = _starpu_ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 *
  522. b_dim1 + 1], &c__1);
  523. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  524. i__3 = k1 - 1;
  525. suml = _starpu_ddot_(&i__3, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 *
  526. c_dim1 + 1], &c__1);
  527. i__3 = l1 - 1;
  528. sumr = _starpu_ddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l1 *
  529. b_dim1 + 1], &c__1);
  530. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  531. d__1 = -sgn * b[l1 + l1 * b_dim1];
  532. _starpu_dlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1 *
  533. a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1,
  534. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  535. if (ierr != 0) {
  536. *info = 1;
  537. }
  538. if (scaloc != 1.) {
  539. i__3 = *n;
  540. for (j = 1; j <= i__3; ++j) {
  541. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  542. /* L80: */
  543. }
  544. *scale *= scaloc;
  545. }
  546. c__[k1 + l1 * c_dim1] = x[0];
  547. c__[k2 + l1 * c_dim1] = x[1];
  548. } else if (l1 != l2 && k1 == k2) {
  549. i__3 = k1 - 1;
  550. suml = _starpu_ddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  551. c_dim1 + 1], &c__1);
  552. i__3 = l1 - 1;
  553. sumr = _starpu_ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 *
  554. b_dim1 + 1], &c__1);
  555. vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn *
  556. sumr));
  557. i__3 = k1 - 1;
  558. suml = _starpu_ddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 *
  559. c_dim1 + 1], &c__1);
  560. i__3 = l1 - 1;
  561. sumr = _starpu_ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l2 *
  562. b_dim1 + 1], &c__1);
  563. vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn *
  564. sumr));
  565. d__1 = -sgn * a[k1 + k1 * a_dim1];
  566. _starpu_dlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1 *
  567. b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1,
  568. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  569. if (ierr != 0) {
  570. *info = 1;
  571. }
  572. if (scaloc != 1.) {
  573. i__3 = *n;
  574. for (j = 1; j <= i__3; ++j) {
  575. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  576. /* L90: */
  577. }
  578. *scale *= scaloc;
  579. }
  580. c__[k1 + l1 * c_dim1] = x[0];
  581. c__[k1 + l2 * c_dim1] = x[1];
  582. } else if (l1 != l2 && k1 != k2) {
  583. i__3 = k1 - 1;
  584. suml = _starpu_ddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  585. c_dim1 + 1], &c__1);
  586. i__3 = l1 - 1;
  587. sumr = _starpu_ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l1 *
  588. b_dim1 + 1], &c__1);
  589. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  590. i__3 = k1 - 1;
  591. suml = _starpu_ddot_(&i__3, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 *
  592. c_dim1 + 1], &c__1);
  593. i__3 = l1 - 1;
  594. sumr = _starpu_ddot_(&i__3, &c__[k1 + c_dim1], ldc, &b[l2 *
  595. b_dim1 + 1], &c__1);
  596. vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);
  597. i__3 = k1 - 1;
  598. suml = _starpu_ddot_(&i__3, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 *
  599. c_dim1 + 1], &c__1);
  600. i__3 = l1 - 1;
  601. sumr = _starpu_ddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l1 *
  602. b_dim1 + 1], &c__1);
  603. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  604. i__3 = k1 - 1;
  605. suml = _starpu_ddot_(&i__3, &a[k2 * a_dim1 + 1], &c__1, &c__[l2 *
  606. c_dim1 + 1], &c__1);
  607. i__3 = l1 - 1;
  608. sumr = _starpu_ddot_(&i__3, &c__[k2 + c_dim1], ldc, &b[l2 *
  609. b_dim1 + 1], &c__1);
  610. vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);
  611. _starpu_dlasy2_(&c_true, &c_false, isgn, &c__2, &c__2, &a[k1 + k1
  612. * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, &
  613. c__2, &scaloc, x, &c__2, &xnorm, &ierr);
  614. if (ierr != 0) {
  615. *info = 1;
  616. }
  617. if (scaloc != 1.) {
  618. i__3 = *n;
  619. for (j = 1; j <= i__3; ++j) {
  620. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  621. /* L100: */
  622. }
  623. *scale *= scaloc;
  624. }
  625. c__[k1 + l1 * c_dim1] = x[0];
  626. c__[k1 + l2 * c_dim1] = x[2];
  627. c__[k2 + l1 * c_dim1] = x[1];
  628. c__[k2 + l2 * c_dim1] = x[3];
  629. }
  630. L110:
  631. ;
  632. }
  633. L120:
  634. ;
  635. }
  636. } else if (! notrna && ! notrnb) {
  637. /* Solve A'*X + ISGN*X*B' = scale*C. */
  638. /* The (K,L)th block of X is determined starting from */
  639. /* top-right corner column by column by */
  640. /* A(K,K)'*X(K,L) + ISGN*X(K,L)*B(L,L)' = C(K,L) - R(K,L) */
  641. /* Where */
  642. /* K-1 N */
  643. /* R(K,L) = SUM [A(I,K)'*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)']. */
  644. /* I=1 J=L+1 */
  645. /* Start column loop (index = L) */
  646. /* L1 (L2): column index of the first (last) row of X(K,L) */
  647. lnext = *n;
  648. for (l = *n; l >= 1; --l) {
  649. if (l > lnext) {
  650. goto L180;
  651. }
  652. if (l == 1) {
  653. l1 = l;
  654. l2 = l;
  655. } else {
  656. if (b[l + (l - 1) * b_dim1] != 0.) {
  657. l1 = l - 1;
  658. l2 = l;
  659. lnext = l - 2;
  660. } else {
  661. l1 = l;
  662. l2 = l;
  663. lnext = l - 1;
  664. }
  665. }
  666. /* Start row loop (index = K) */
  667. /* K1 (K2): row index of the first (last) row of X(K,L) */
  668. knext = 1;
  669. i__1 = *m;
  670. for (k = 1; k <= i__1; ++k) {
  671. if (k < knext) {
  672. goto L170;
  673. }
  674. if (k == *m) {
  675. k1 = k;
  676. k2 = k;
  677. } else {
  678. if (a[k + 1 + k * a_dim1] != 0.) {
  679. k1 = k;
  680. k2 = k + 1;
  681. knext = k + 2;
  682. } else {
  683. k1 = k;
  684. k2 = k;
  685. knext = k + 1;
  686. }
  687. }
  688. if (l1 == l2 && k1 == k2) {
  689. i__2 = k1 - 1;
  690. suml = _starpu_ddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  691. c_dim1 + 1], &c__1);
  692. i__2 = *n - l1;
  693. /* Computing MIN */
  694. i__3 = l1 + 1;
  695. /* Computing MIN */
  696. i__4 = l1 + 1;
  697. sumr = _starpu_ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc,
  698. &b[l1 + min(i__4, *n)* b_dim1], ldb);
  699. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  700. scaloc = 1.;
  701. a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
  702. da11 = abs(a11);
  703. if (da11 <= smin) {
  704. a11 = smin;
  705. da11 = smin;
  706. *info = 1;
  707. }
  708. db = abs(vec[0]);
  709. if (da11 < 1. && db > 1.) {
  710. if (db > bignum * da11) {
  711. scaloc = 1. / db;
  712. }
  713. }
  714. x[0] = vec[0] * scaloc / a11;
  715. if (scaloc != 1.) {
  716. i__2 = *n;
  717. for (j = 1; j <= i__2; ++j) {
  718. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  719. /* L130: */
  720. }
  721. *scale *= scaloc;
  722. }
  723. c__[k1 + l1 * c_dim1] = x[0];
  724. } else if (l1 == l2 && k1 != k2) {
  725. i__2 = k1 - 1;
  726. suml = _starpu_ddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  727. c_dim1 + 1], &c__1);
  728. i__2 = *n - l2;
  729. /* Computing MIN */
  730. i__3 = l2 + 1;
  731. /* Computing MIN */
  732. i__4 = l2 + 1;
  733. sumr = _starpu_ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc,
  734. &b[l1 + min(i__4, *n)* b_dim1], ldb);
  735. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  736. i__2 = k1 - 1;
  737. suml = _starpu_ddot_(&i__2, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 *
  738. c_dim1 + 1], &c__1);
  739. i__2 = *n - l2;
  740. /* Computing MIN */
  741. i__3 = l2 + 1;
  742. /* Computing MIN */
  743. i__4 = l2 + 1;
  744. sumr = _starpu_ddot_(&i__2, &c__[k2 + min(i__3, *n)* c_dim1], ldc,
  745. &b[l1 + min(i__4, *n)* b_dim1], ldb);
  746. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  747. d__1 = -sgn * b[l1 + l1 * b_dim1];
  748. _starpu_dlaln2_(&c_true, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1 *
  749. a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1,
  750. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  751. if (ierr != 0) {
  752. *info = 1;
  753. }
  754. if (scaloc != 1.) {
  755. i__2 = *n;
  756. for (j = 1; j <= i__2; ++j) {
  757. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  758. /* L140: */
  759. }
  760. *scale *= scaloc;
  761. }
  762. c__[k1 + l1 * c_dim1] = x[0];
  763. c__[k2 + l1 * c_dim1] = x[1];
  764. } else if (l1 != l2 && k1 == k2) {
  765. i__2 = k1 - 1;
  766. suml = _starpu_ddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  767. c_dim1 + 1], &c__1);
  768. i__2 = *n - l2;
  769. /* Computing MIN */
  770. i__3 = l2 + 1;
  771. /* Computing MIN */
  772. i__4 = l2 + 1;
  773. sumr = _starpu_ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc,
  774. &b[l1 + min(i__4, *n)* b_dim1], ldb);
  775. vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn *
  776. sumr));
  777. i__2 = k1 - 1;
  778. suml = _starpu_ddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 *
  779. c_dim1 + 1], &c__1);
  780. i__2 = *n - l2;
  781. /* Computing MIN */
  782. i__3 = l2 + 1;
  783. /* Computing MIN */
  784. i__4 = l2 + 1;
  785. sumr = _starpu_ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc,
  786. &b[l2 + min(i__4, *n)* b_dim1], ldb);
  787. vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn *
  788. sumr));
  789. d__1 = -sgn * a[k1 + k1 * a_dim1];
  790. _starpu_dlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1
  791. * b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1,
  792. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  793. if (ierr != 0) {
  794. *info = 1;
  795. }
  796. if (scaloc != 1.) {
  797. i__2 = *n;
  798. for (j = 1; j <= i__2; ++j) {
  799. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  800. /* L150: */
  801. }
  802. *scale *= scaloc;
  803. }
  804. c__[k1 + l1 * c_dim1] = x[0];
  805. c__[k1 + l2 * c_dim1] = x[1];
  806. } else if (l1 != l2 && k1 != k2) {
  807. i__2 = k1 - 1;
  808. suml = _starpu_ddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l1 *
  809. c_dim1 + 1], &c__1);
  810. i__2 = *n - l2;
  811. /* Computing MIN */
  812. i__3 = l2 + 1;
  813. /* Computing MIN */
  814. i__4 = l2 + 1;
  815. sumr = _starpu_ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc,
  816. &b[l1 + min(i__4, *n)* b_dim1], ldb);
  817. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  818. i__2 = k1 - 1;
  819. suml = _starpu_ddot_(&i__2, &a[k1 * a_dim1 + 1], &c__1, &c__[l2 *
  820. c_dim1 + 1], &c__1);
  821. i__2 = *n - l2;
  822. /* Computing MIN */
  823. i__3 = l2 + 1;
  824. /* Computing MIN */
  825. i__4 = l2 + 1;
  826. sumr = _starpu_ddot_(&i__2, &c__[k1 + min(i__3, *n)* c_dim1], ldc,
  827. &b[l2 + min(i__4, *n)* b_dim1], ldb);
  828. vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);
  829. i__2 = k1 - 1;
  830. suml = _starpu_ddot_(&i__2, &a[k2 * a_dim1 + 1], &c__1, &c__[l1 *
  831. c_dim1 + 1], &c__1);
  832. i__2 = *n - l2;
  833. /* Computing MIN */
  834. i__3 = l2 + 1;
  835. /* Computing MIN */
  836. i__4 = l2 + 1;
  837. sumr = _starpu_ddot_(&i__2, &c__[k2 + min(i__3, *n)* c_dim1], ldc,
  838. &b[l1 + min(i__4, *n)* b_dim1], ldb);
  839. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  840. i__2 = k1 - 1;
  841. suml = _starpu_ddot_(&i__2, &a[k2 * a_dim1 + 1], &c__1, &c__[l2 *
  842. c_dim1 + 1], &c__1);
  843. i__2 = *n - l2;
  844. /* Computing MIN */
  845. i__3 = l2 + 1;
  846. /* Computing MIN */
  847. i__4 = l2 + 1;
  848. sumr = _starpu_ddot_(&i__2, &c__[k2 + min(i__3, *n)* c_dim1], ldc,
  849. &b[l2 + min(i__4, *n)* b_dim1], ldb);
  850. vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);
  851. _starpu_dlasy2_(&c_true, &c_true, isgn, &c__2, &c__2, &a[k1 + k1 *
  852. a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, &
  853. c__2, &scaloc, x, &c__2, &xnorm, &ierr);
  854. if (ierr != 0) {
  855. *info = 1;
  856. }
  857. if (scaloc != 1.) {
  858. i__2 = *n;
  859. for (j = 1; j <= i__2; ++j) {
  860. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  861. /* L160: */
  862. }
  863. *scale *= scaloc;
  864. }
  865. c__[k1 + l1 * c_dim1] = x[0];
  866. c__[k1 + l2 * c_dim1] = x[2];
  867. c__[k2 + l1 * c_dim1] = x[1];
  868. c__[k2 + l2 * c_dim1] = x[3];
  869. }
  870. L170:
  871. ;
  872. }
  873. L180:
  874. ;
  875. }
  876. } else if (notrna && ! notrnb) {
  877. /* Solve A*X + ISGN*X*B' = scale*C. */
  878. /* The (K,L)th block of X is determined starting from */
  879. /* bottom-right corner column by column by */
  880. /* A(K,K)*X(K,L) + ISGN*X(K,L)*B(L,L)' = C(K,L) - R(K,L) */
  881. /* Where */
  882. /* M N */
  883. /* R(K,L) = SUM [A(K,I)*X(I,L)] + ISGN*SUM [X(K,J)*B(L,J)']. */
  884. /* I=K+1 J=L+1 */
  885. /* Start column loop (index = L) */
  886. /* L1 (L2): column index of the first (last) row of X(K,L) */
  887. lnext = *n;
  888. for (l = *n; l >= 1; --l) {
  889. if (l > lnext) {
  890. goto L240;
  891. }
  892. if (l == 1) {
  893. l1 = l;
  894. l2 = l;
  895. } else {
  896. if (b[l + (l - 1) * b_dim1] != 0.) {
  897. l1 = l - 1;
  898. l2 = l;
  899. lnext = l - 2;
  900. } else {
  901. l1 = l;
  902. l2 = l;
  903. lnext = l - 1;
  904. }
  905. }
  906. /* Start row loop (index = K) */
  907. /* K1 (K2): row index of the first (last) row of X(K,L) */
  908. knext = *m;
  909. for (k = *m; k >= 1; --k) {
  910. if (k > knext) {
  911. goto L230;
  912. }
  913. if (k == 1) {
  914. k1 = k;
  915. k2 = k;
  916. } else {
  917. if (a[k + (k - 1) * a_dim1] != 0.) {
  918. k1 = k - 1;
  919. k2 = k;
  920. knext = k - 2;
  921. } else {
  922. k1 = k;
  923. k2 = k;
  924. knext = k - 1;
  925. }
  926. }
  927. if (l1 == l2 && k1 == k2) {
  928. i__1 = *m - k1;
  929. /* Computing MIN */
  930. i__2 = k1 + 1;
  931. /* Computing MIN */
  932. i__3 = k1 + 1;
  933. suml = _starpu_ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
  934. c__[min(i__3, *m)+ l1 * c_dim1], &c__1);
  935. i__1 = *n - l1;
  936. /* Computing MIN */
  937. i__2 = l1 + 1;
  938. /* Computing MIN */
  939. i__3 = l1 + 1;
  940. sumr = _starpu_ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc,
  941. &b[l1 + min(i__3, *n)* b_dim1], ldb);
  942. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  943. scaloc = 1.;
  944. a11 = a[k1 + k1 * a_dim1] + sgn * b[l1 + l1 * b_dim1];
  945. da11 = abs(a11);
  946. if (da11 <= smin) {
  947. a11 = smin;
  948. da11 = smin;
  949. *info = 1;
  950. }
  951. db = abs(vec[0]);
  952. if (da11 < 1. && db > 1.) {
  953. if (db > bignum * da11) {
  954. scaloc = 1. / db;
  955. }
  956. }
  957. x[0] = vec[0] * scaloc / a11;
  958. if (scaloc != 1.) {
  959. i__1 = *n;
  960. for (j = 1; j <= i__1; ++j) {
  961. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  962. /* L190: */
  963. }
  964. *scale *= scaloc;
  965. }
  966. c__[k1 + l1 * c_dim1] = x[0];
  967. } else if (l1 == l2 && k1 != k2) {
  968. i__1 = *m - k2;
  969. /* Computing MIN */
  970. i__2 = k2 + 1;
  971. /* Computing MIN */
  972. i__3 = k2 + 1;
  973. suml = _starpu_ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
  974. c__[min(i__3, *m)+ l1 * c_dim1], &c__1);
  975. i__1 = *n - l2;
  976. /* Computing MIN */
  977. i__2 = l2 + 1;
  978. /* Computing MIN */
  979. i__3 = l2 + 1;
  980. sumr = _starpu_ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc,
  981. &b[l1 + min(i__3, *n)* b_dim1], ldb);
  982. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  983. i__1 = *m - k2;
  984. /* Computing MIN */
  985. i__2 = k2 + 1;
  986. /* Computing MIN */
  987. i__3 = k2 + 1;
  988. suml = _starpu_ddot_(&i__1, &a[k2 + min(i__2, *m)* a_dim1], lda, &
  989. c__[min(i__3, *m)+ l1 * c_dim1], &c__1);
  990. i__1 = *n - l2;
  991. /* Computing MIN */
  992. i__2 = l2 + 1;
  993. /* Computing MIN */
  994. i__3 = l2 + 1;
  995. sumr = _starpu_ddot_(&i__1, &c__[k2 + min(i__2, *n)* c_dim1], ldc,
  996. &b[l1 + min(i__3, *n)* b_dim1], ldb);
  997. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  998. d__1 = -sgn * b[l1 + l1 * b_dim1];
  999. _starpu_dlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &a[k1 + k1
  1000. * a_dim1], lda, &c_b26, &c_b26, vec, &c__2, &d__1,
  1001. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  1002. if (ierr != 0) {
  1003. *info = 1;
  1004. }
  1005. if (scaloc != 1.) {
  1006. i__1 = *n;
  1007. for (j = 1; j <= i__1; ++j) {
  1008. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  1009. /* L200: */
  1010. }
  1011. *scale *= scaloc;
  1012. }
  1013. c__[k1 + l1 * c_dim1] = x[0];
  1014. c__[k2 + l1 * c_dim1] = x[1];
  1015. } else if (l1 != l2 && k1 == k2) {
  1016. i__1 = *m - k1;
  1017. /* Computing MIN */
  1018. i__2 = k1 + 1;
  1019. /* Computing MIN */
  1020. i__3 = k1 + 1;
  1021. suml = _starpu_ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
  1022. c__[min(i__3, *m)+ l1 * c_dim1], &c__1);
  1023. i__1 = *n - l2;
  1024. /* Computing MIN */
  1025. i__2 = l2 + 1;
  1026. /* Computing MIN */
  1027. i__3 = l2 + 1;
  1028. sumr = _starpu_ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc,
  1029. &b[l1 + min(i__3, *n)* b_dim1], ldb);
  1030. vec[0] = sgn * (c__[k1 + l1 * c_dim1] - (suml + sgn *
  1031. sumr));
  1032. i__1 = *m - k1;
  1033. /* Computing MIN */
  1034. i__2 = k1 + 1;
  1035. /* Computing MIN */
  1036. i__3 = k1 + 1;
  1037. suml = _starpu_ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
  1038. c__[min(i__3, *m)+ l2 * c_dim1], &c__1);
  1039. i__1 = *n - l2;
  1040. /* Computing MIN */
  1041. i__2 = l2 + 1;
  1042. /* Computing MIN */
  1043. i__3 = l2 + 1;
  1044. sumr = _starpu_ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc,
  1045. &b[l2 + min(i__3, *n)* b_dim1], ldb);
  1046. vec[1] = sgn * (c__[k1 + l2 * c_dim1] - (suml + sgn *
  1047. sumr));
  1048. d__1 = -sgn * a[k1 + k1 * a_dim1];
  1049. _starpu_dlaln2_(&c_false, &c__2, &c__1, &smin, &c_b26, &b[l1 + l1
  1050. * b_dim1], ldb, &c_b26, &c_b26, vec, &c__2, &d__1,
  1051. &c_b30, x, &c__2, &scaloc, &xnorm, &ierr);
  1052. if (ierr != 0) {
  1053. *info = 1;
  1054. }
  1055. if (scaloc != 1.) {
  1056. i__1 = *n;
  1057. for (j = 1; j <= i__1; ++j) {
  1058. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  1059. /* L210: */
  1060. }
  1061. *scale *= scaloc;
  1062. }
  1063. c__[k1 + l1 * c_dim1] = x[0];
  1064. c__[k1 + l2 * c_dim1] = x[1];
  1065. } else if (l1 != l2 && k1 != k2) {
  1066. i__1 = *m - k2;
  1067. /* Computing MIN */
  1068. i__2 = k2 + 1;
  1069. /* Computing MIN */
  1070. i__3 = k2 + 1;
  1071. suml = _starpu_ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
  1072. c__[min(i__3, *m)+ l1 * c_dim1], &c__1);
  1073. i__1 = *n - l2;
  1074. /* Computing MIN */
  1075. i__2 = l2 + 1;
  1076. /* Computing MIN */
  1077. i__3 = l2 + 1;
  1078. sumr = _starpu_ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc,
  1079. &b[l1 + min(i__3, *n)* b_dim1], ldb);
  1080. vec[0] = c__[k1 + l1 * c_dim1] - (suml + sgn * sumr);
  1081. i__1 = *m - k2;
  1082. /* Computing MIN */
  1083. i__2 = k2 + 1;
  1084. /* Computing MIN */
  1085. i__3 = k2 + 1;
  1086. suml = _starpu_ddot_(&i__1, &a[k1 + min(i__2, *m)* a_dim1], lda, &
  1087. c__[min(i__3, *m)+ l2 * c_dim1], &c__1);
  1088. i__1 = *n - l2;
  1089. /* Computing MIN */
  1090. i__2 = l2 + 1;
  1091. /* Computing MIN */
  1092. i__3 = l2 + 1;
  1093. sumr = _starpu_ddot_(&i__1, &c__[k1 + min(i__2, *n)* c_dim1], ldc,
  1094. &b[l2 + min(i__3, *n)* b_dim1], ldb);
  1095. vec[2] = c__[k1 + l2 * c_dim1] - (suml + sgn * sumr);
  1096. i__1 = *m - k2;
  1097. /* Computing MIN */
  1098. i__2 = k2 + 1;
  1099. /* Computing MIN */
  1100. i__3 = k2 + 1;
  1101. suml = _starpu_ddot_(&i__1, &a[k2 + min(i__2, *m)* a_dim1], lda, &
  1102. c__[min(i__3, *m)+ l1 * c_dim1], &c__1);
  1103. i__1 = *n - l2;
  1104. /* Computing MIN */
  1105. i__2 = l2 + 1;
  1106. /* Computing MIN */
  1107. i__3 = l2 + 1;
  1108. sumr = _starpu_ddot_(&i__1, &c__[k2 + min(i__2, *n)* c_dim1], ldc,
  1109. &b[l1 + min(i__3, *n)* b_dim1], ldb);
  1110. vec[1] = c__[k2 + l1 * c_dim1] - (suml + sgn * sumr);
  1111. i__1 = *m - k2;
  1112. /* Computing MIN */
  1113. i__2 = k2 + 1;
  1114. /* Computing MIN */
  1115. i__3 = k2 + 1;
  1116. suml = _starpu_ddot_(&i__1, &a[k2 + min(i__2, *m)* a_dim1], lda, &
  1117. c__[min(i__3, *m)+ l2 * c_dim1], &c__1);
  1118. i__1 = *n - l2;
  1119. /* Computing MIN */
  1120. i__2 = l2 + 1;
  1121. /* Computing MIN */
  1122. i__3 = l2 + 1;
  1123. sumr = _starpu_ddot_(&i__1, &c__[k2 + min(i__2, *n)* c_dim1], ldc,
  1124. &b[l2 + min(i__3, *n)* b_dim1], ldb);
  1125. vec[3] = c__[k2 + l2 * c_dim1] - (suml + sgn * sumr);
  1126. _starpu_dlasy2_(&c_false, &c_true, isgn, &c__2, &c__2, &a[k1 + k1
  1127. * a_dim1], lda, &b[l1 + l1 * b_dim1], ldb, vec, &
  1128. c__2, &scaloc, x, &c__2, &xnorm, &ierr);
  1129. if (ierr != 0) {
  1130. *info = 1;
  1131. }
  1132. if (scaloc != 1.) {
  1133. i__1 = *n;
  1134. for (j = 1; j <= i__1; ++j) {
  1135. _starpu_dscal_(m, &scaloc, &c__[j * c_dim1 + 1], &c__1);
  1136. /* L220: */
  1137. }
  1138. *scale *= scaloc;
  1139. }
  1140. c__[k1 + l1 * c_dim1] = x[0];
  1141. c__[k1 + l2 * c_dim1] = x[2];
  1142. c__[k2 + l1 * c_dim1] = x[1];
  1143. c__[k2 + l2 * c_dim1] = x[3];
  1144. }
  1145. L230:
  1146. ;
  1147. }
  1148. L240:
  1149. ;
  1150. }
  1151. }
  1152. return 0;
  1153. /* End of DTRSYL */
  1154. } /* _starpu_dtrsyl_ */