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

c_cblas3_3m.c 21 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647
  1. /*
  2. * Written by D.P. Manley, Digital Equipment Corporation.
  3. * Prefixed "C_" to BLAS routines and their declarations.
  4. *
  5. * Modified by T. H. Do, 4/15/98, SGI/CRAY Research.
  6. */
  7. #include <stdlib.h>
  8. #include "common.h"
  9. #include "cblas_test.h"
  10. #define TEST_COL_MJR 0
  11. #define TEST_ROW_MJR 1
  12. #define UNDEFINED -1
  13. void F77_cgemm(int *order, char *transpa, char *transpb, int *m, int *n,
  14. int *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  15. CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
  16. CBLAS_TEST_COMPLEX *c, int *ldc ) {
  17. CBLAS_TEST_COMPLEX *A, *B, *C;
  18. int i,j,LDA, LDB, LDC;
  19. enum CBLAS_TRANSPOSE transa, transb;
  20. get_transpose_type(transpa, &transa);
  21. get_transpose_type(transpb, &transb);
  22. if (*order == TEST_ROW_MJR) {
  23. if (transa == CblasNoTrans) {
  24. LDA = *k+1;
  25. A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  26. for( i=0; i<*m; i++ )
  27. for( j=0; j<*k; j++ ) {
  28. A[i*LDA+j].real=a[j*(*lda)+i].real;
  29. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  30. }
  31. }
  32. else {
  33. LDA = *m+1;
  34. A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
  35. for( i=0; i<*k; i++ )
  36. for( j=0; j<*m; j++ ) {
  37. A[i*LDA+j].real=a[j*(*lda)+i].real;
  38. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  39. }
  40. }
  41. if (transb == CblasNoTrans) {
  42. LDB = *n+1;
  43. B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) );
  44. for( i=0; i<*k; i++ )
  45. for( j=0; j<*n; j++ ) {
  46. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  47. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  48. }
  49. }
  50. else {
  51. LDB = *k+1;
  52. B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX));
  53. for( i=0; i<*n; i++ )
  54. for( j=0; j<*k; j++ ) {
  55. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  56. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  57. }
  58. }
  59. LDC = *n+1;
  60. C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX));
  61. for( j=0; j<*n; j++ )
  62. for( i=0; i<*m; i++ ) {
  63. C[i*LDC+j].real=c[j*(*ldc)+i].real;
  64. C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
  65. }
  66. cblas_cgemm( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA,
  67. B, LDB, beta, C, LDC );
  68. for( j=0; j<*n; j++ )
  69. for( i=0; i<*m; i++ ) {
  70. c[j*(*ldc)+i].real=C[i*LDC+j].real;
  71. c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
  72. }
  73. free(A);
  74. free(B);
  75. free(C);
  76. }
  77. else if (*order == TEST_COL_MJR)
  78. cblas_cgemm( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda,
  79. b, *ldb, beta, c, *ldc );
  80. else
  81. cblas_cgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda,
  82. b, *ldb, beta, c, *ldc );
  83. }
  84. void F77_chemm(int *order, char *rtlf, char *uplow, int *m, int *n,
  85. CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  86. CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
  87. CBLAS_TEST_COMPLEX *c, int *ldc ) {
  88. CBLAS_TEST_COMPLEX *A, *B, *C;
  89. int i,j,LDA, LDB, LDC;
  90. enum CBLAS_UPLO uplo;
  91. enum CBLAS_SIDE side;
  92. get_uplo_type(uplow,&uplo);
  93. get_side_type(rtlf,&side);
  94. if (*order == TEST_ROW_MJR) {
  95. if (side == CblasLeft) {
  96. LDA = *m+1;
  97. A= (CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  98. for( i=0; i<*m; i++ )
  99. for( j=0; j<*m; j++ ) {
  100. A[i*LDA+j].real=a[j*(*lda)+i].real;
  101. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  102. }
  103. }
  104. else{
  105. LDA = *n+1;
  106. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
  107. for( i=0; i<*n; i++ )
  108. for( j=0; j<*n; j++ ) {
  109. A[i*LDA+j].real=a[j*(*lda)+i].real;
  110. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  111. }
  112. }
  113. LDB = *n+1;
  114. B=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDB*sizeof(CBLAS_TEST_COMPLEX ) );
  115. for( i=0; i<*m; i++ )
  116. for( j=0; j<*n; j++ ) {
  117. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  118. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  119. }
  120. LDC = *n+1;
  121. C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
  122. for( j=0; j<*n; j++ )
  123. for( i=0; i<*m; i++ ) {
  124. C[i*LDC+j].real=c[j*(*ldc)+i].real;
  125. C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
  126. }
  127. cblas_chemm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB,
  128. beta, C, LDC );
  129. for( j=0; j<*n; j++ )
  130. for( i=0; i<*m; i++ ) {
  131. c[j*(*ldc)+i].real=C[i*LDC+j].real;
  132. c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
  133. }
  134. free(A);
  135. free(B);
  136. free(C);
  137. }
  138. else if (*order == TEST_COL_MJR)
  139. cblas_chemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
  140. beta, c, *ldc );
  141. else
  142. cblas_chemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
  143. beta, c, *ldc );
  144. }
  145. void F77_csymm(int *order, char *rtlf, char *uplow, int *m, int *n,
  146. CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  147. CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
  148. CBLAS_TEST_COMPLEX *c, int *ldc ) {
  149. CBLAS_TEST_COMPLEX *A, *B, *C;
  150. int i,j,LDA, LDB, LDC;
  151. enum CBLAS_UPLO uplo;
  152. enum CBLAS_SIDE side;
  153. get_uplo_type(uplow,&uplo);
  154. get_side_type(rtlf,&side);
  155. if (*order == TEST_ROW_MJR) {
  156. if (side == CblasLeft) {
  157. LDA = *m+1;
  158. A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  159. for( i=0; i<*m; i++ )
  160. for( j=0; j<*m; j++ )
  161. A[i*LDA+j]=a[j*(*lda)+i];
  162. }
  163. else{
  164. LDA = *n+1;
  165. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
  166. for( i=0; i<*n; i++ )
  167. for( j=0; j<*n; j++ )
  168. A[i*LDA+j]=a[j*(*lda)+i];
  169. }
  170. LDB = *n+1;
  171. B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX ));
  172. for( i=0; i<*m; i++ )
  173. for( j=0; j<*n; j++ )
  174. B[i*LDB+j]=b[j*(*ldb)+i];
  175. LDC = *n+1;
  176. C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX));
  177. for( j=0; j<*n; j++ )
  178. for( i=0; i<*m; i++ )
  179. C[i*LDC+j]=c[j*(*ldc)+i];
  180. cblas_csymm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB,
  181. beta, C, LDC );
  182. for( j=0; j<*n; j++ )
  183. for( i=0; i<*m; i++ )
  184. c[j*(*ldc)+i]=C[i*LDC+j];
  185. free(A);
  186. free(B);
  187. free(C);
  188. }
  189. else if (*order == TEST_COL_MJR)
  190. cblas_csymm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
  191. beta, c, *ldc );
  192. else
  193. cblas_csymm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
  194. beta, c, *ldc );
  195. }
  196. void F77_cherk(int *order, char *uplow, char *transp, int *n, int *k,
  197. float *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  198. float *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) {
  199. int i,j,LDA,LDC;
  200. CBLAS_TEST_COMPLEX *A, *C;
  201. enum CBLAS_UPLO uplo;
  202. enum CBLAS_TRANSPOSE trans;
  203. get_uplo_type(uplow,&uplo);
  204. get_transpose_type(transp,&trans);
  205. if (*order == TEST_ROW_MJR) {
  206. if (trans == CblasNoTrans) {
  207. LDA = *k+1;
  208. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
  209. for( i=0; i<*n; i++ )
  210. for( j=0; j<*k; j++ ) {
  211. A[i*LDA+j].real=a[j*(*lda)+i].real;
  212. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  213. }
  214. }
  215. else{
  216. LDA = *n+1;
  217. A=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
  218. for( i=0; i<*k; i++ )
  219. for( j=0; j<*n; j++ ) {
  220. A[i*LDA+j].real=a[j*(*lda)+i].real;
  221. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  222. }
  223. }
  224. LDC = *n+1;
  225. C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
  226. for( i=0; i<*n; i++ )
  227. for( j=0; j<*n; j++ ) {
  228. C[i*LDC+j].real=c[j*(*ldc)+i].real;
  229. C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
  230. }
  231. cblas_cherk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta,
  232. C, LDC );
  233. for( j=0; j<*n; j++ )
  234. for( i=0; i<*n; i++ ) {
  235. c[j*(*ldc)+i].real=C[i*LDC+j].real;
  236. c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
  237. }
  238. free(A);
  239. free(C);
  240. }
  241. else if (*order == TEST_COL_MJR)
  242. cblas_cherk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
  243. c, *ldc );
  244. else
  245. cblas_cherk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
  246. c, *ldc );
  247. }
  248. void F77_csyrk(int *order, char *uplow, char *transp, int *n, int *k,
  249. CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  250. CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) {
  251. int i,j,LDA,LDC;
  252. CBLAS_TEST_COMPLEX *A, *C;
  253. enum CBLAS_UPLO uplo;
  254. enum CBLAS_TRANSPOSE trans;
  255. get_uplo_type(uplow,&uplo);
  256. get_transpose_type(transp,&trans);
  257. if (*order == TEST_ROW_MJR) {
  258. if (trans == CblasNoTrans) {
  259. LDA = *k+1;
  260. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  261. for( i=0; i<*n; i++ )
  262. for( j=0; j<*k; j++ ) {
  263. A[i*LDA+j].real=a[j*(*lda)+i].real;
  264. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  265. }
  266. }
  267. else{
  268. LDA = *n+1;
  269. A=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
  270. for( i=0; i<*k; i++ )
  271. for( j=0; j<*n; j++ ) {
  272. A[i*LDA+j].real=a[j*(*lda)+i].real;
  273. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  274. }
  275. }
  276. LDC = *n+1;
  277. C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
  278. for( i=0; i<*n; i++ )
  279. for( j=0; j<*n; j++ ) {
  280. C[i*LDC+j].real=c[j*(*ldc)+i].real;
  281. C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
  282. }
  283. cblas_csyrk(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, beta,
  284. C, LDC );
  285. for( j=0; j<*n; j++ )
  286. for( i=0; i<*n; i++ ) {
  287. c[j*(*ldc)+i].real=C[i*LDC+j].real;
  288. c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
  289. }
  290. free(A);
  291. free(C);
  292. }
  293. else if (*order == TEST_COL_MJR)
  294. cblas_csyrk(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta,
  295. c, *ldc );
  296. else
  297. cblas_csyrk(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, beta,
  298. c, *ldc );
  299. }
  300. void F77_cher2k(int *order, char *uplow, char *transp, int *n, int *k,
  301. CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  302. CBLAS_TEST_COMPLEX *b, int *ldb, float *beta,
  303. CBLAS_TEST_COMPLEX *c, int *ldc ) {
  304. int i,j,LDA,LDB,LDC;
  305. CBLAS_TEST_COMPLEX *A, *B, *C;
  306. enum CBLAS_UPLO uplo;
  307. enum CBLAS_TRANSPOSE trans;
  308. get_uplo_type(uplow,&uplo);
  309. get_transpose_type(transp,&trans);
  310. if (*order == TEST_ROW_MJR) {
  311. if (trans == CblasNoTrans) {
  312. LDA = *k+1;
  313. LDB = *k+1;
  314. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
  315. B=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_COMPLEX ));
  316. for( i=0; i<*n; i++ )
  317. for( j=0; j<*k; j++ ) {
  318. A[i*LDA+j].real=a[j*(*lda)+i].real;
  319. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  320. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  321. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  322. }
  323. }
  324. else {
  325. LDA = *n+1;
  326. LDB = *n+1;
  327. A=(CBLAS_TEST_COMPLEX* )malloc( LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX ) );
  328. B=(CBLAS_TEST_COMPLEX* )malloc( LDB*(*k)*sizeof(CBLAS_TEST_COMPLEX ) );
  329. for( i=0; i<*k; i++ )
  330. for( j=0; j<*n; j++ ){
  331. A[i*LDA+j].real=a[j*(*lda)+i].real;
  332. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  333. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  334. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  335. }
  336. }
  337. LDC = *n+1;
  338. C=(CBLAS_TEST_COMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
  339. for( i=0; i<*n; i++ )
  340. for( j=0; j<*n; j++ ) {
  341. C[i*LDC+j].real=c[j*(*ldc)+i].real;
  342. C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
  343. }
  344. cblas_cher2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
  345. B, LDB, *beta, C, LDC );
  346. for( j=0; j<*n; j++ )
  347. for( i=0; i<*n; i++ ) {
  348. c[j*(*ldc)+i].real=C[i*LDC+j].real;
  349. c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
  350. }
  351. free(A);
  352. free(B);
  353. free(C);
  354. }
  355. else if (*order == TEST_COL_MJR)
  356. cblas_cher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
  357. b, *ldb, *beta, c, *ldc );
  358. else
  359. cblas_cher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
  360. b, *ldb, *beta, c, *ldc );
  361. }
  362. void F77_csyr2k(int *order, char *uplow, char *transp, int *n, int *k,
  363. CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  364. CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
  365. CBLAS_TEST_COMPLEX *c, int *ldc ) {
  366. int i,j,LDA,LDB,LDC;
  367. CBLAS_TEST_COMPLEX *A, *B, *C;
  368. enum CBLAS_UPLO uplo;
  369. enum CBLAS_TRANSPOSE trans;
  370. get_uplo_type(uplow,&uplo);
  371. get_transpose_type(transp,&trans);
  372. if (*order == TEST_ROW_MJR) {
  373. if (trans == CblasNoTrans) {
  374. LDA = *k+1;
  375. LDB = *k+1;
  376. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  377. B=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_COMPLEX));
  378. for( i=0; i<*n; i++ )
  379. for( j=0; j<*k; j++ ) {
  380. A[i*LDA+j].real=a[j*(*lda)+i].real;
  381. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  382. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  383. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  384. }
  385. }
  386. else {
  387. LDA = *n+1;
  388. LDB = *n+1;
  389. A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
  390. B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*k)*sizeof(CBLAS_TEST_COMPLEX));
  391. for( i=0; i<*k; i++ )
  392. for( j=0; j<*n; j++ ){
  393. A[i*LDA+j].real=a[j*(*lda)+i].real;
  394. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  395. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  396. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  397. }
  398. }
  399. LDC = *n+1;
  400. C=(CBLAS_TEST_COMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_COMPLEX));
  401. for( i=0; i<*n; i++ )
  402. for( j=0; j<*n; j++ ) {
  403. C[i*LDC+j].real=c[j*(*ldc)+i].real;
  404. C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
  405. }
  406. cblas_csyr2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
  407. B, LDB, beta, C, LDC );
  408. for( j=0; j<*n; j++ )
  409. for( i=0; i<*n; i++ ) {
  410. c[j*(*ldc)+i].real=C[i*LDC+j].real;
  411. c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
  412. }
  413. free(A);
  414. free(B);
  415. free(C);
  416. }
  417. else if (*order == TEST_COL_MJR)
  418. cblas_csyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
  419. b, *ldb, beta, c, *ldc );
  420. else
  421. cblas_csyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
  422. b, *ldb, beta, c, *ldc );
  423. }
  424. void F77_ctrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
  425. int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
  426. int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) {
  427. int i,j,LDA,LDB;
  428. CBLAS_TEST_COMPLEX *A, *B;
  429. enum CBLAS_SIDE side;
  430. enum CBLAS_DIAG diag;
  431. enum CBLAS_UPLO uplo;
  432. enum CBLAS_TRANSPOSE trans;
  433. get_uplo_type(uplow,&uplo);
  434. get_transpose_type(transp,&trans);
  435. get_diag_type(diagn,&diag);
  436. get_side_type(rtlf,&side);
  437. if (*order == TEST_ROW_MJR) {
  438. if (side == CblasLeft) {
  439. LDA = *m+1;
  440. A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  441. for( i=0; i<*m; i++ )
  442. for( j=0; j<*m; j++ ) {
  443. A[i*LDA+j].real=a[j*(*lda)+i].real;
  444. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  445. }
  446. }
  447. else{
  448. LDA = *n+1;
  449. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  450. for( i=0; i<*n; i++ )
  451. for( j=0; j<*n; j++ ) {
  452. A[i*LDA+j].real=a[j*(*lda)+i].real;
  453. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  454. }
  455. }
  456. LDB = *n+1;
  457. B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX));
  458. for( i=0; i<*m; i++ )
  459. for( j=0; j<*n; j++ ) {
  460. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  461. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  462. }
  463. cblas_ctrmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha,
  464. A, LDA, B, LDB );
  465. for( j=0; j<*n; j++ )
  466. for( i=0; i<*m; i++ ) {
  467. b[j*(*ldb)+i].real=B[i*LDB+j].real;
  468. b[j*(*ldb)+i].imag=B[i*LDB+j].imag;
  469. }
  470. free(A);
  471. free(B);
  472. }
  473. else if (*order == TEST_COL_MJR)
  474. cblas_ctrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
  475. a, *lda, b, *ldb);
  476. else
  477. cblas_ctrmm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
  478. a, *lda, b, *ldb);
  479. }
  480. void F77_ctrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
  481. int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
  482. int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) {
  483. int i,j,LDA,LDB;
  484. CBLAS_TEST_COMPLEX *A, *B;
  485. enum CBLAS_SIDE side;
  486. enum CBLAS_DIAG diag;
  487. enum CBLAS_UPLO uplo;
  488. enum CBLAS_TRANSPOSE trans;
  489. get_uplo_type(uplow,&uplo);
  490. get_transpose_type(transp,&trans);
  491. get_diag_type(diagn,&diag);
  492. get_side_type(rtlf,&side);
  493. if (*order == TEST_ROW_MJR) {
  494. if (side == CblasLeft) {
  495. LDA = *m+1;
  496. A=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
  497. for( i=0; i<*m; i++ )
  498. for( j=0; j<*m; j++ ) {
  499. A[i*LDA+j].real=a[j*(*lda)+i].real;
  500. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  501. }
  502. }
  503. else{
  504. LDA = *n+1;
  505. A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  506. for( i=0; i<*n; i++ )
  507. for( j=0; j<*n; j++ ) {
  508. A[i*LDA+j].real=a[j*(*lda)+i].real;
  509. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  510. }
  511. }
  512. LDB = *n+1;
  513. B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX));
  514. for( i=0; i<*m; i++ )
  515. for( j=0; j<*n; j++ ) {
  516. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  517. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  518. }
  519. cblas_ctrsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha,
  520. A, LDA, B, LDB );
  521. for( j=0; j<*n; j++ )
  522. for( i=0; i<*m; i++ ) {
  523. b[j*(*ldb)+i].real=B[i*LDB+j].real;
  524. b[j*(*ldb)+i].imag=B[i*LDB+j].imag;
  525. }
  526. free(A);
  527. free(B);
  528. }
  529. else if (*order == TEST_COL_MJR)
  530. cblas_ctrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
  531. a, *lda, b, *ldb);
  532. else
  533. cblas_ctrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
  534. a, *lda, b, *ldb);
  535. }
  536. void F77_cgemm3m(int *order, char *transpa, char *transpb, int *m, int *n,
  537. int *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
  538. CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
  539. CBLAS_TEST_COMPLEX *c, int *ldc ) {
  540. CBLAS_TEST_COMPLEX *A, *B, *C;
  541. int i,j,LDA, LDB, LDC;
  542. enum CBLAS_TRANSPOSE transa, transb;
  543. get_transpose_type(transpa, &transa);
  544. get_transpose_type(transpb, &transb);
  545. if (*order == TEST_ROW_MJR) {
  546. if (transa == CblasNoTrans) {
  547. LDA = *k+1;
  548. A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
  549. for( i=0; i<*m; i++ )
  550. for( j=0; j<*k; j++ ) {
  551. A[i*LDA+j].real=a[j*(*lda)+i].real;
  552. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  553. }
  554. }
  555. else {
  556. LDA = *m+1;
  557. A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
  558. for( i=0; i<*k; i++ )
  559. for( j=0; j<*m; j++ ) {
  560. A[i*LDA+j].real=a[j*(*lda)+i].real;
  561. A[i*LDA+j].imag=a[j*(*lda)+i].imag;
  562. }
  563. }
  564. if (transb == CblasNoTrans) {
  565. LDB = *n+1;
  566. B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) );
  567. for( i=0; i<*k; i++ )
  568. for( j=0; j<*n; j++ ) {
  569. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  570. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  571. }
  572. }
  573. else {
  574. LDB = *k+1;
  575. B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX));
  576. for( i=0; i<*n; i++ )
  577. for( j=0; j<*k; j++ ) {
  578. B[i*LDB+j].real=b[j*(*ldb)+i].real;
  579. B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
  580. }
  581. }
  582. LDC = *n+1;
  583. C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX));
  584. for( j=0; j<*n; j++ )
  585. for( i=0; i<*m; i++ ) {
  586. C[i*LDC+j].real=c[j*(*ldc)+i].real;
  587. C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
  588. }
  589. cblas_cgemm3m( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA,
  590. B, LDB, beta, C, LDC );
  591. for( j=0; j<*n; j++ )
  592. for( i=0; i<*m; i++ ) {
  593. c[j*(*ldc)+i].real=C[i*LDC+j].real;
  594. c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
  595. }
  596. free(A);
  597. free(B);
  598. free(C);
  599. }
  600. else if (*order == TEST_COL_MJR)
  601. cblas_cgemm3m( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda,
  602. b, *ldb, beta, c, *ldc );
  603. else
  604. cblas_cgemm3m( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda,
  605. b, *ldb, beta, c, *ldc );
  606. }