ztrsm.c 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699
  1. /* ztrsm.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 doublecomplex c_b1 = {1.,0.};
  15. /* Subroutine */ int ztrsm_(char *side, char *uplo, char *transa, char *diag,
  16. integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
  17. integer *lda, doublecomplex *b, integer *ldb)
  18. {
  19. /* System generated locals */
  20. integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3, i__4, i__5,
  21. i__6, i__7;
  22. doublecomplex z__1, z__2, z__3;
  23. /* Builtin functions */
  24. void z_div(doublecomplex *, doublecomplex *, doublecomplex *), d_cnjg(
  25. doublecomplex *, doublecomplex *);
  26. /* Local variables */
  27. integer i__, j, k, info;
  28. doublecomplex temp;
  29. logical lside;
  30. extern logical lsame_(char *, char *);
  31. integer nrowa;
  32. logical upper;
  33. extern /* Subroutine */ int xerbla_(char *, integer *);
  34. logical noconj, nounit;
  35. /* .. Scalar Arguments .. */
  36. /* .. */
  37. /* .. Array Arguments .. */
  38. /* .. */
  39. /* Purpose */
  40. /* ======= */
  41. /* ZTRSM solves one of the matrix equations */
  42. /* op( A )*X = alpha*B, or X*op( A ) = alpha*B, */
  43. /* where alpha is a scalar, X and B are m by n matrices, A is a unit, or */
  44. /* non-unit, upper or lower triangular matrix and op( A ) is one of */
  45. /* op( A ) = A or op( A ) = A' or op( A ) = conjg( A' ). */
  46. /* The matrix X is overwritten on B. */
  47. /* Arguments */
  48. /* ========== */
  49. /* SIDE - CHARACTER*1. */
  50. /* On entry, SIDE specifies whether op( A ) appears on the left */
  51. /* or right of X as follows: */
  52. /* SIDE = 'L' or 'l' op( A )*X = alpha*B. */
  53. /* SIDE = 'R' or 'r' X*op( A ) = alpha*B. */
  54. /* Unchanged on exit. */
  55. /* UPLO - CHARACTER*1. */
  56. /* On entry, UPLO specifies whether the matrix A is an upper or */
  57. /* lower triangular matrix as follows: */
  58. /* UPLO = 'U' or 'u' A is an upper triangular matrix. */
  59. /* UPLO = 'L' or 'l' A is a lower triangular matrix. */
  60. /* Unchanged on exit. */
  61. /* TRANSA - CHARACTER*1. */
  62. /* On entry, TRANSA specifies the form of op( A ) to be used in */
  63. /* the matrix multiplication as follows: */
  64. /* TRANSA = 'N' or 'n' op( A ) = A. */
  65. /* TRANSA = 'T' or 't' op( A ) = A'. */
  66. /* TRANSA = 'C' or 'c' op( A ) = conjg( A' ). */
  67. /* Unchanged on exit. */
  68. /* DIAG - CHARACTER*1. */
  69. /* On entry, DIAG specifies whether or not A is unit triangular */
  70. /* as follows: */
  71. /* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
  72. /* DIAG = 'N' or 'n' A is not assumed to be unit */
  73. /* triangular. */
  74. /* Unchanged on exit. */
  75. /* M - INTEGER. */
  76. /* On entry, M specifies the number of rows of B. M must be at */
  77. /* least zero. */
  78. /* Unchanged on exit. */
  79. /* N - INTEGER. */
  80. /* On entry, N specifies the number of columns of B. N must be */
  81. /* at least zero. */
  82. /* Unchanged on exit. */
  83. /* ALPHA - COMPLEX*16 . */
  84. /* On entry, ALPHA specifies the scalar alpha. When alpha is */
  85. /* zero then A is not referenced and B need not be set before */
  86. /* entry. */
  87. /* Unchanged on exit. */
  88. /* A - COMPLEX*16 array of DIMENSION ( LDA, k ), where k is m */
  89. /* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. */
  90. /* Before entry with UPLO = 'U' or 'u', the leading k by k */
  91. /* upper triangular part of the array A must contain the upper */
  92. /* triangular matrix and the strictly lower triangular part of */
  93. /* A is not referenced. */
  94. /* Before entry with UPLO = 'L' or 'l', the leading k by k */
  95. /* lower triangular part of the array A must contain the lower */
  96. /* triangular matrix and the strictly upper triangular part of */
  97. /* A is not referenced. */
  98. /* Note that when DIAG = 'U' or 'u', the diagonal elements of */
  99. /* A are not referenced either, but are assumed to be unity. */
  100. /* Unchanged on exit. */
  101. /* LDA - INTEGER. */
  102. /* On entry, LDA specifies the first dimension of A as declared */
  103. /* in the calling (sub) program. When SIDE = 'L' or 'l' then */
  104. /* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' */
  105. /* then LDA must be at least max( 1, n ). */
  106. /* Unchanged on exit. */
  107. /* B - COMPLEX*16 array of DIMENSION ( LDB, n ). */
  108. /* Before entry, the leading m by n part of the array B must */
  109. /* contain the right-hand side matrix B, and on exit is */
  110. /* overwritten by the solution matrix X. */
  111. /* LDB - INTEGER. */
  112. /* On entry, LDB specifies the first dimension of B as declared */
  113. /* in the calling (sub) program. LDB must be at least */
  114. /* max( 1, m ). */
  115. /* Unchanged on exit. */
  116. /* Level 3 Blas routine. */
  117. /* -- Written on 8-February-1989. */
  118. /* Jack Dongarra, Argonne National Laboratory. */
  119. /* Iain Duff, AERE Harwell. */
  120. /* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
  121. /* Sven Hammarling, Numerical Algorithms Group Ltd. */
  122. /* .. External Functions .. */
  123. /* .. */
  124. /* .. External Subroutines .. */
  125. /* .. */
  126. /* .. Intrinsic Functions .. */
  127. /* .. */
  128. /* .. Local Scalars .. */
  129. /* .. */
  130. /* .. Parameters .. */
  131. /* .. */
  132. /* Test the input parameters. */
  133. /* Parameter adjustments */
  134. a_dim1 = *lda;
  135. a_offset = 1 + a_dim1;
  136. a -= a_offset;
  137. b_dim1 = *ldb;
  138. b_offset = 1 + b_dim1;
  139. b -= b_offset;
  140. /* Function Body */
  141. lside = lsame_(side, "L");
  142. if (lside) {
  143. nrowa = *m;
  144. } else {
  145. nrowa = *n;
  146. }
  147. noconj = lsame_(transa, "T");
  148. nounit = lsame_(diag, "N");
  149. upper = lsame_(uplo, "U");
  150. info = 0;
  151. if (! lside && ! lsame_(side, "R")) {
  152. info = 1;
  153. } else if (! upper && ! lsame_(uplo, "L")) {
  154. info = 2;
  155. } else if (! lsame_(transa, "N") && ! lsame_(transa,
  156. "T") && ! lsame_(transa, "C")) {
  157. info = 3;
  158. } else if (! lsame_(diag, "U") && ! lsame_(diag,
  159. "N")) {
  160. info = 4;
  161. } else if (*m < 0) {
  162. info = 5;
  163. } else if (*n < 0) {
  164. info = 6;
  165. } else if (*lda < max(1,nrowa)) {
  166. info = 9;
  167. } else if (*ldb < max(1,*m)) {
  168. info = 11;
  169. }
  170. if (info != 0) {
  171. xerbla_("ZTRSM ", &info);
  172. return 0;
  173. }
  174. /* Quick return if possible. */
  175. if (*m == 0 || *n == 0) {
  176. return 0;
  177. }
  178. /* And when alpha.eq.zero. */
  179. if (alpha->r == 0. && alpha->i == 0.) {
  180. i__1 = *n;
  181. for (j = 1; j <= i__1; ++j) {
  182. i__2 = *m;
  183. for (i__ = 1; i__ <= i__2; ++i__) {
  184. i__3 = i__ + j * b_dim1;
  185. b[i__3].r = 0., b[i__3].i = 0.;
  186. /* L10: */
  187. }
  188. /* L20: */
  189. }
  190. return 0;
  191. }
  192. /* Start the operations. */
  193. if (lside) {
  194. if (lsame_(transa, "N")) {
  195. /* Form B := alpha*inv( A )*B. */
  196. if (upper) {
  197. i__1 = *n;
  198. for (j = 1; j <= i__1; ++j) {
  199. if (alpha->r != 1. || alpha->i != 0.) {
  200. i__2 = *m;
  201. for (i__ = 1; i__ <= i__2; ++i__) {
  202. i__3 = i__ + j * b_dim1;
  203. i__4 = i__ + j * b_dim1;
  204. z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
  205. .i, z__1.i = alpha->r * b[i__4].i +
  206. alpha->i * b[i__4].r;
  207. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  208. /* L30: */
  209. }
  210. }
  211. for (k = *m; k >= 1; --k) {
  212. i__2 = k + j * b_dim1;
  213. if (b[i__2].r != 0. || b[i__2].i != 0.) {
  214. if (nounit) {
  215. i__2 = k + j * b_dim1;
  216. z_div(&z__1, &b[k + j * b_dim1], &a[k + k *
  217. a_dim1]);
  218. b[i__2].r = z__1.r, b[i__2].i = z__1.i;
  219. }
  220. i__2 = k - 1;
  221. for (i__ = 1; i__ <= i__2; ++i__) {
  222. i__3 = i__ + j * b_dim1;
  223. i__4 = i__ + j * b_dim1;
  224. i__5 = k + j * b_dim1;
  225. i__6 = i__ + k * a_dim1;
  226. z__2.r = b[i__5].r * a[i__6].r - b[i__5].i *
  227. a[i__6].i, z__2.i = b[i__5].r * a[
  228. i__6].i + b[i__5].i * a[i__6].r;
  229. z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
  230. .i - z__2.i;
  231. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  232. /* L40: */
  233. }
  234. }
  235. /* L50: */
  236. }
  237. /* L60: */
  238. }
  239. } else {
  240. i__1 = *n;
  241. for (j = 1; j <= i__1; ++j) {
  242. if (alpha->r != 1. || alpha->i != 0.) {
  243. i__2 = *m;
  244. for (i__ = 1; i__ <= i__2; ++i__) {
  245. i__3 = i__ + j * b_dim1;
  246. i__4 = i__ + j * b_dim1;
  247. z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
  248. .i, z__1.i = alpha->r * b[i__4].i +
  249. alpha->i * b[i__4].r;
  250. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  251. /* L70: */
  252. }
  253. }
  254. i__2 = *m;
  255. for (k = 1; k <= i__2; ++k) {
  256. i__3 = k + j * b_dim1;
  257. if (b[i__3].r != 0. || b[i__3].i != 0.) {
  258. if (nounit) {
  259. i__3 = k + j * b_dim1;
  260. z_div(&z__1, &b[k + j * b_dim1], &a[k + k *
  261. a_dim1]);
  262. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  263. }
  264. i__3 = *m;
  265. for (i__ = k + 1; i__ <= i__3; ++i__) {
  266. i__4 = i__ + j * b_dim1;
  267. i__5 = i__ + j * b_dim1;
  268. i__6 = k + j * b_dim1;
  269. i__7 = i__ + k * a_dim1;
  270. z__2.r = b[i__6].r * a[i__7].r - b[i__6].i *
  271. a[i__7].i, z__2.i = b[i__6].r * a[
  272. i__7].i + b[i__6].i * a[i__7].r;
  273. z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
  274. .i - z__2.i;
  275. b[i__4].r = z__1.r, b[i__4].i = z__1.i;
  276. /* L80: */
  277. }
  278. }
  279. /* L90: */
  280. }
  281. /* L100: */
  282. }
  283. }
  284. } else {
  285. /* Form B := alpha*inv( A' )*B */
  286. /* or B := alpha*inv( conjg( A' ) )*B. */
  287. if (upper) {
  288. i__1 = *n;
  289. for (j = 1; j <= i__1; ++j) {
  290. i__2 = *m;
  291. for (i__ = 1; i__ <= i__2; ++i__) {
  292. i__3 = i__ + j * b_dim1;
  293. z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3].i,
  294. z__1.i = alpha->r * b[i__3].i + alpha->i * b[
  295. i__3].r;
  296. temp.r = z__1.r, temp.i = z__1.i;
  297. if (noconj) {
  298. i__3 = i__ - 1;
  299. for (k = 1; k <= i__3; ++k) {
  300. i__4 = k + i__ * a_dim1;
  301. i__5 = k + j * b_dim1;
  302. z__2.r = a[i__4].r * b[i__5].r - a[i__4].i *
  303. b[i__5].i, z__2.i = a[i__4].r * b[
  304. i__5].i + a[i__4].i * b[i__5].r;
  305. z__1.r = temp.r - z__2.r, z__1.i = temp.i -
  306. z__2.i;
  307. temp.r = z__1.r, temp.i = z__1.i;
  308. /* L110: */
  309. }
  310. if (nounit) {
  311. z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
  312. temp.r = z__1.r, temp.i = z__1.i;
  313. }
  314. } else {
  315. i__3 = i__ - 1;
  316. for (k = 1; k <= i__3; ++k) {
  317. d_cnjg(&z__3, &a[k + i__ * a_dim1]);
  318. i__4 = k + j * b_dim1;
  319. z__2.r = z__3.r * b[i__4].r - z__3.i * b[i__4]
  320. .i, z__2.i = z__3.r * b[i__4].i +
  321. z__3.i * b[i__4].r;
  322. z__1.r = temp.r - z__2.r, z__1.i = temp.i -
  323. z__2.i;
  324. temp.r = z__1.r, temp.i = z__1.i;
  325. /* L120: */
  326. }
  327. if (nounit) {
  328. d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
  329. z_div(&z__1, &temp, &z__2);
  330. temp.r = z__1.r, temp.i = z__1.i;
  331. }
  332. }
  333. i__3 = i__ + j * b_dim1;
  334. b[i__3].r = temp.r, b[i__3].i = temp.i;
  335. /* L130: */
  336. }
  337. /* L140: */
  338. }
  339. } else {
  340. i__1 = *n;
  341. for (j = 1; j <= i__1; ++j) {
  342. for (i__ = *m; i__ >= 1; --i__) {
  343. i__2 = i__ + j * b_dim1;
  344. z__1.r = alpha->r * b[i__2].r - alpha->i * b[i__2].i,
  345. z__1.i = alpha->r * b[i__2].i + alpha->i * b[
  346. i__2].r;
  347. temp.r = z__1.r, temp.i = z__1.i;
  348. if (noconj) {
  349. i__2 = *m;
  350. for (k = i__ + 1; k <= i__2; ++k) {
  351. i__3 = k + i__ * a_dim1;
  352. i__4 = k + j * b_dim1;
  353. z__2.r = a[i__3].r * b[i__4].r - a[i__3].i *
  354. b[i__4].i, z__2.i = a[i__3].r * b[
  355. i__4].i + a[i__3].i * b[i__4].r;
  356. z__1.r = temp.r - z__2.r, z__1.i = temp.i -
  357. z__2.i;
  358. temp.r = z__1.r, temp.i = z__1.i;
  359. /* L150: */
  360. }
  361. if (nounit) {
  362. z_div(&z__1, &temp, &a[i__ + i__ * a_dim1]);
  363. temp.r = z__1.r, temp.i = z__1.i;
  364. }
  365. } else {
  366. i__2 = *m;
  367. for (k = i__ + 1; k <= i__2; ++k) {
  368. d_cnjg(&z__3, &a[k + i__ * a_dim1]);
  369. i__3 = k + j * b_dim1;
  370. z__2.r = z__3.r * b[i__3].r - z__3.i * b[i__3]
  371. .i, z__2.i = z__3.r * b[i__3].i +
  372. z__3.i * b[i__3].r;
  373. z__1.r = temp.r - z__2.r, z__1.i = temp.i -
  374. z__2.i;
  375. temp.r = z__1.r, temp.i = z__1.i;
  376. /* L160: */
  377. }
  378. if (nounit) {
  379. d_cnjg(&z__2, &a[i__ + i__ * a_dim1]);
  380. z_div(&z__1, &temp, &z__2);
  381. temp.r = z__1.r, temp.i = z__1.i;
  382. }
  383. }
  384. i__2 = i__ + j * b_dim1;
  385. b[i__2].r = temp.r, b[i__2].i = temp.i;
  386. /* L170: */
  387. }
  388. /* L180: */
  389. }
  390. }
  391. }
  392. } else {
  393. if (lsame_(transa, "N")) {
  394. /* Form B := alpha*B*inv( A ). */
  395. if (upper) {
  396. i__1 = *n;
  397. for (j = 1; j <= i__1; ++j) {
  398. if (alpha->r != 1. || alpha->i != 0.) {
  399. i__2 = *m;
  400. for (i__ = 1; i__ <= i__2; ++i__) {
  401. i__3 = i__ + j * b_dim1;
  402. i__4 = i__ + j * b_dim1;
  403. z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
  404. .i, z__1.i = alpha->r * b[i__4].i +
  405. alpha->i * b[i__4].r;
  406. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  407. /* L190: */
  408. }
  409. }
  410. i__2 = j - 1;
  411. for (k = 1; k <= i__2; ++k) {
  412. i__3 = k + j * a_dim1;
  413. if (a[i__3].r != 0. || a[i__3].i != 0.) {
  414. i__3 = *m;
  415. for (i__ = 1; i__ <= i__3; ++i__) {
  416. i__4 = i__ + j * b_dim1;
  417. i__5 = i__ + j * b_dim1;
  418. i__6 = k + j * a_dim1;
  419. i__7 = i__ + k * b_dim1;
  420. z__2.r = a[i__6].r * b[i__7].r - a[i__6].i *
  421. b[i__7].i, z__2.i = a[i__6].r * b[
  422. i__7].i + a[i__6].i * b[i__7].r;
  423. z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
  424. .i - z__2.i;
  425. b[i__4].r = z__1.r, b[i__4].i = z__1.i;
  426. /* L200: */
  427. }
  428. }
  429. /* L210: */
  430. }
  431. if (nounit) {
  432. z_div(&z__1, &c_b1, &a[j + j * a_dim1]);
  433. temp.r = z__1.r, temp.i = z__1.i;
  434. i__2 = *m;
  435. for (i__ = 1; i__ <= i__2; ++i__) {
  436. i__3 = i__ + j * b_dim1;
  437. i__4 = i__ + j * b_dim1;
  438. z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
  439. z__1.i = temp.r * b[i__4].i + temp.i * b[
  440. i__4].r;
  441. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  442. /* L220: */
  443. }
  444. }
  445. /* L230: */
  446. }
  447. } else {
  448. for (j = *n; j >= 1; --j) {
  449. if (alpha->r != 1. || alpha->i != 0.) {
  450. i__1 = *m;
  451. for (i__ = 1; i__ <= i__1; ++i__) {
  452. i__2 = i__ + j * b_dim1;
  453. i__3 = i__ + j * b_dim1;
  454. z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
  455. .i, z__1.i = alpha->r * b[i__3].i +
  456. alpha->i * b[i__3].r;
  457. b[i__2].r = z__1.r, b[i__2].i = z__1.i;
  458. /* L240: */
  459. }
  460. }
  461. i__1 = *n;
  462. for (k = j + 1; k <= i__1; ++k) {
  463. i__2 = k + j * a_dim1;
  464. if (a[i__2].r != 0. || a[i__2].i != 0.) {
  465. i__2 = *m;
  466. for (i__ = 1; i__ <= i__2; ++i__) {
  467. i__3 = i__ + j * b_dim1;
  468. i__4 = i__ + j * b_dim1;
  469. i__5 = k + j * a_dim1;
  470. i__6 = i__ + k * b_dim1;
  471. z__2.r = a[i__5].r * b[i__6].r - a[i__5].i *
  472. b[i__6].i, z__2.i = a[i__5].r * b[
  473. i__6].i + a[i__5].i * b[i__6].r;
  474. z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
  475. .i - z__2.i;
  476. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  477. /* L250: */
  478. }
  479. }
  480. /* L260: */
  481. }
  482. if (nounit) {
  483. z_div(&z__1, &c_b1, &a[j + j * a_dim1]);
  484. temp.r = z__1.r, temp.i = z__1.i;
  485. i__1 = *m;
  486. for (i__ = 1; i__ <= i__1; ++i__) {
  487. i__2 = i__ + j * b_dim1;
  488. i__3 = i__ + j * b_dim1;
  489. z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
  490. z__1.i = temp.r * b[i__3].i + temp.i * b[
  491. i__3].r;
  492. b[i__2].r = z__1.r, b[i__2].i = z__1.i;
  493. /* L270: */
  494. }
  495. }
  496. /* L280: */
  497. }
  498. }
  499. } else {
  500. /* Form B := alpha*B*inv( A' ) */
  501. /* or B := alpha*B*inv( conjg( A' ) ). */
  502. if (upper) {
  503. for (k = *n; k >= 1; --k) {
  504. if (nounit) {
  505. if (noconj) {
  506. z_div(&z__1, &c_b1, &a[k + k * a_dim1]);
  507. temp.r = z__1.r, temp.i = z__1.i;
  508. } else {
  509. d_cnjg(&z__2, &a[k + k * a_dim1]);
  510. z_div(&z__1, &c_b1, &z__2);
  511. temp.r = z__1.r, temp.i = z__1.i;
  512. }
  513. i__1 = *m;
  514. for (i__ = 1; i__ <= i__1; ++i__) {
  515. i__2 = i__ + k * b_dim1;
  516. i__3 = i__ + k * b_dim1;
  517. z__1.r = temp.r * b[i__3].r - temp.i * b[i__3].i,
  518. z__1.i = temp.r * b[i__3].i + temp.i * b[
  519. i__3].r;
  520. b[i__2].r = z__1.r, b[i__2].i = z__1.i;
  521. /* L290: */
  522. }
  523. }
  524. i__1 = k - 1;
  525. for (j = 1; j <= i__1; ++j) {
  526. i__2 = j + k * a_dim1;
  527. if (a[i__2].r != 0. || a[i__2].i != 0.) {
  528. if (noconj) {
  529. i__2 = j + k * a_dim1;
  530. temp.r = a[i__2].r, temp.i = a[i__2].i;
  531. } else {
  532. d_cnjg(&z__1, &a[j + k * a_dim1]);
  533. temp.r = z__1.r, temp.i = z__1.i;
  534. }
  535. i__2 = *m;
  536. for (i__ = 1; i__ <= i__2; ++i__) {
  537. i__3 = i__ + j * b_dim1;
  538. i__4 = i__ + j * b_dim1;
  539. i__5 = i__ + k * b_dim1;
  540. z__2.r = temp.r * b[i__5].r - temp.i * b[i__5]
  541. .i, z__2.i = temp.r * b[i__5].i +
  542. temp.i * b[i__5].r;
  543. z__1.r = b[i__4].r - z__2.r, z__1.i = b[i__4]
  544. .i - z__2.i;
  545. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  546. /* L300: */
  547. }
  548. }
  549. /* L310: */
  550. }
  551. if (alpha->r != 1. || alpha->i != 0.) {
  552. i__1 = *m;
  553. for (i__ = 1; i__ <= i__1; ++i__) {
  554. i__2 = i__ + k * b_dim1;
  555. i__3 = i__ + k * b_dim1;
  556. z__1.r = alpha->r * b[i__3].r - alpha->i * b[i__3]
  557. .i, z__1.i = alpha->r * b[i__3].i +
  558. alpha->i * b[i__3].r;
  559. b[i__2].r = z__1.r, b[i__2].i = z__1.i;
  560. /* L320: */
  561. }
  562. }
  563. /* L330: */
  564. }
  565. } else {
  566. i__1 = *n;
  567. for (k = 1; k <= i__1; ++k) {
  568. if (nounit) {
  569. if (noconj) {
  570. z_div(&z__1, &c_b1, &a[k + k * a_dim1]);
  571. temp.r = z__1.r, temp.i = z__1.i;
  572. } else {
  573. d_cnjg(&z__2, &a[k + k * a_dim1]);
  574. z_div(&z__1, &c_b1, &z__2);
  575. temp.r = z__1.r, temp.i = z__1.i;
  576. }
  577. i__2 = *m;
  578. for (i__ = 1; i__ <= i__2; ++i__) {
  579. i__3 = i__ + k * b_dim1;
  580. i__4 = i__ + k * b_dim1;
  581. z__1.r = temp.r * b[i__4].r - temp.i * b[i__4].i,
  582. z__1.i = temp.r * b[i__4].i + temp.i * b[
  583. i__4].r;
  584. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  585. /* L340: */
  586. }
  587. }
  588. i__2 = *n;
  589. for (j = k + 1; j <= i__2; ++j) {
  590. i__3 = j + k * a_dim1;
  591. if (a[i__3].r != 0. || a[i__3].i != 0.) {
  592. if (noconj) {
  593. i__3 = j + k * a_dim1;
  594. temp.r = a[i__3].r, temp.i = a[i__3].i;
  595. } else {
  596. d_cnjg(&z__1, &a[j + k * a_dim1]);
  597. temp.r = z__1.r, temp.i = z__1.i;
  598. }
  599. i__3 = *m;
  600. for (i__ = 1; i__ <= i__3; ++i__) {
  601. i__4 = i__ + j * b_dim1;
  602. i__5 = i__ + j * b_dim1;
  603. i__6 = i__ + k * b_dim1;
  604. z__2.r = temp.r * b[i__6].r - temp.i * b[i__6]
  605. .i, z__2.i = temp.r * b[i__6].i +
  606. temp.i * b[i__6].r;
  607. z__1.r = b[i__5].r - z__2.r, z__1.i = b[i__5]
  608. .i - z__2.i;
  609. b[i__4].r = z__1.r, b[i__4].i = z__1.i;
  610. /* L350: */
  611. }
  612. }
  613. /* L360: */
  614. }
  615. if (alpha->r != 1. || alpha->i != 0.) {
  616. i__2 = *m;
  617. for (i__ = 1; i__ <= i__2; ++i__) {
  618. i__3 = i__ + k * b_dim1;
  619. i__4 = i__ + k * b_dim1;
  620. z__1.r = alpha->r * b[i__4].r - alpha->i * b[i__4]
  621. .i, z__1.i = alpha->r * b[i__4].i +
  622. alpha->i * b[i__4].r;
  623. b[i__3].r = z__1.r, b[i__3].i = z__1.i;
  624. /* L370: */
  625. }
  626. }
  627. /* L380: */
  628. }
  629. }
  630. }
  631. }
  632. return 0;
  633. /* End of ZTRSM . */
  634. } /* ztrsm_ */