ctrmm.c 19 KB

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