zgemm.c 20 KB

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