00001
00002
00003
00004
00005
00006
00007 #include <stdlib.h>
00008 #include "cblas.h"
00009 #include "cblas_test.h"
00010 #define TEST_COL_MJR 0
00011 #define TEST_ROW_MJR 1
00012 #define UNDEFINED -1
00013
00014 void F77_cgemm(int *order, char *transpa, char *transpb, int *m, int *n,
00015 int *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00016 CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
00017 CBLAS_TEST_COMPLEX *c, int *ldc ) {
00018
00019 CBLAS_TEST_COMPLEX *A, *B, *C;
00020 int i,j,LDA, LDB, LDC;
00021 enum CBLAS_TRANSPOSE transa, transb;
00022
00023 get_transpose_type(transpa, &transa);
00024 get_transpose_type(transpb, &transb);
00025
00026 if (*order == TEST_ROW_MJR) {
00027 if (transa == CblasNoTrans) {
00028 LDA = *k+1;
00029 A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00030 for( i=0; i<*m; i++ )
00031 for( j=0; j<*k; j++ ) {
00032 A[i*LDA+j].real=a[j*(*lda)+i].real;
00033 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00034 }
00035 }
00036 else {
00037 LDA = *m+1;
00038 A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
00039 for( i=0; i<*k; i++ )
00040 for( j=0; j<*m; j++ ) {
00041 A[i*LDA+j].real=a[j*(*lda)+i].real;
00042 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00043 }
00044 }
00045
00046 if (transb == CblasNoTrans) {
00047 LDB = *n+1;
00048 B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) );
00049 for( i=0; i<*k; i++ )
00050 for( j=0; j<*n; j++ ) {
00051 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00052 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00053 }
00054 }
00055 else {
00056 LDB = *k+1;
00057 B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX));
00058 for( i=0; i<*n; i++ )
00059 for( j=0; j<*k; j++ ) {
00060 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00061 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00062 }
00063 }
00064
00065 LDC = *n+1;
00066 C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX));
00067 for( j=0; j<*n; j++ )
00068 for( i=0; i<*m; i++ ) {
00069 C[i*LDC+j].real=c[j*(*ldc)+i].real;
00070 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
00071 }
00072 cblas_cgemm( CblasRowMajor, transa, transb, *m, *n, *k, alpha, A, LDA,
00073 B, LDB, beta, C, LDC );
00074 for( j=0; j<*n; j++ )
00075 for( i=0; i<*m; i++ ) {
00076 c[j*(*ldc)+i].real=C[i*LDC+j].real;
00077 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
00078 }
00079 free(A);
00080 free(B);
00081 free(C);
00082 }
00083 else if (*order == TEST_COL_MJR)
00084 cblas_cgemm( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda,
00085 b, *ldb, beta, c, *ldc );
00086 else
00087 cblas_cgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda,
00088 b, *ldb, beta, c, *ldc );
00089 }
00090 void F77_chemm(int *order, char *rtlf, char *uplow, int *m, int *n,
00091 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00092 CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
00093 CBLAS_TEST_COMPLEX *c, int *ldc ) {
00094
00095 CBLAS_TEST_COMPLEX *A, *B, *C;
00096 int i,j,LDA, LDB, LDC;
00097 enum CBLAS_UPLO uplo;
00098 enum CBLAS_SIDE side;
00099
00100 get_uplo_type(uplow,&uplo);
00101 get_side_type(rtlf,&side);
00102
00103 if (*order == TEST_ROW_MJR) {
00104 if (side == CblasLeft) {
00105 LDA = *m+1;
00106 A= (CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00107 for( i=0; i<*m; i++ )
00108 for( j=0; j<*m; j++ ) {
00109 A[i*LDA+j].real=a[j*(*lda)+i].real;
00110 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00111 }
00112 }
00113 else{
00114 LDA = *n+1;
00115 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00116 for( i=0; i<*n; i++ )
00117 for( j=0; j<*n; j++ ) {
00118 A[i*LDA+j].real=a[j*(*lda)+i].real;
00119 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00120 }
00121 }
00122 LDB = *n+1;
00123 B=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDB*sizeof(CBLAS_TEST_COMPLEX ) );
00124 for( i=0; i<*m; i++ )
00125 for( j=0; j<*n; j++ ) {
00126 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00127 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00128 }
00129 LDC = *n+1;
00130 C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
00131 for( j=0; j<*n; j++ )
00132 for( i=0; i<*m; i++ ) {
00133 C[i*LDC+j].real=c[j*(*ldc)+i].real;
00134 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
00135 }
00136 cblas_chemm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB,
00137 beta, C, LDC );
00138 for( j=0; j<*n; j++ )
00139 for( i=0; i<*m; i++ ) {
00140 c[j*(*ldc)+i].real=C[i*LDC+j].real;
00141 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
00142 }
00143 free(A);
00144 free(B);
00145 free(C);
00146 }
00147 else if (*order == TEST_COL_MJR)
00148 cblas_chemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
00149 beta, c, *ldc );
00150 else
00151 cblas_chemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
00152 beta, c, *ldc );
00153 }
00154 void F77_csymm(int *order, char *rtlf, char *uplow, int *m, int *n,
00155 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00156 CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
00157 CBLAS_TEST_COMPLEX *c, int *ldc ) {
00158
00159 CBLAS_TEST_COMPLEX *A, *B, *C;
00160 int i,j,LDA, LDB, LDC;
00161 enum CBLAS_UPLO uplo;
00162 enum CBLAS_SIDE side;
00163
00164 get_uplo_type(uplow,&uplo);
00165 get_side_type(rtlf,&side);
00166
00167 if (*order == TEST_ROW_MJR) {
00168 if (side == CblasLeft) {
00169 LDA = *m+1;
00170 A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00171 for( i=0; i<*m; i++ )
00172 for( j=0; j<*m; j++ )
00173 A[i*LDA+j]=a[j*(*lda)+i];
00174 }
00175 else{
00176 LDA = *n+1;
00177 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00178 for( i=0; i<*n; i++ )
00179 for( j=0; j<*n; j++ )
00180 A[i*LDA+j]=a[j*(*lda)+i];
00181 }
00182 LDB = *n+1;
00183 B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX ));
00184 for( i=0; i<*m; i++ )
00185 for( j=0; j<*n; j++ )
00186 B[i*LDB+j]=b[j*(*ldb)+i];
00187 LDC = *n+1;
00188 C=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_COMPLEX));
00189 for( j=0; j<*n; j++ )
00190 for( i=0; i<*m; i++ )
00191 C[i*LDC+j]=c[j*(*ldc)+i];
00192 cblas_csymm( CblasRowMajor, side, uplo, *m, *n, alpha, A, LDA, B, LDB,
00193 beta, C, LDC );
00194 for( j=0; j<*n; j++ )
00195 for( i=0; i<*m; i++ )
00196 c[j*(*ldc)+i]=C[i*LDC+j];
00197 free(A);
00198 free(B);
00199 free(C);
00200 }
00201 else if (*order == TEST_COL_MJR)
00202 cblas_csymm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
00203 beta, c, *ldc );
00204 else
00205 cblas_csymm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
00206 beta, c, *ldc );
00207 }
00208
00209 void F77_cherk(int *order, char *uplow, char *transp, int *n, int *k,
00210 float *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00211 float *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) {
00212
00213 int i,j,LDA,LDC;
00214 CBLAS_TEST_COMPLEX *A, *C;
00215 enum CBLAS_UPLO uplo;
00216 enum CBLAS_TRANSPOSE trans;
00217
00218 get_uplo_type(uplow,&uplo);
00219 get_transpose_type(transp,&trans);
00220
00221 if (*order == TEST_ROW_MJR) {
00222 if (trans == CblasNoTrans) {
00223 LDA = *k+1;
00224 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00225 for( i=0; i<*n; i++ )
00226 for( j=0; j<*k; j++ ) {
00227 A[i*LDA+j].real=a[j*(*lda)+i].real;
00228 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00229 }
00230 }
00231 else{
00232 LDA = *n+1;
00233 A=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00234 for( i=0; i<*k; i++ )
00235 for( j=0; j<*n; j++ ) {
00236 A[i*LDA+j].real=a[j*(*lda)+i].real;
00237 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00238 }
00239 }
00240 LDC = *n+1;
00241 C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
00242 for( i=0; i<*n; i++ )
00243 for( j=0; j<*n; j++ ) {
00244 C[i*LDC+j].real=c[j*(*ldc)+i].real;
00245 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
00246 }
00247 cblas_cherk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta,
00248 C, LDC );
00249 for( j=0; j<*n; j++ )
00250 for( i=0; i<*n; i++ ) {
00251 c[j*(*ldc)+i].real=C[i*LDC+j].real;
00252 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
00253 }
00254 free(A);
00255 free(C);
00256 }
00257 else if (*order == TEST_COL_MJR)
00258 cblas_cherk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
00259 c, *ldc );
00260 else
00261 cblas_cherk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
00262 c, *ldc );
00263 }
00264
00265 void F77_csyrk(int *order, char *uplow, char *transp, int *n, int *k,
00266 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00267 CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) {
00268
00269 int i,j,LDA,LDC;
00270 CBLAS_TEST_COMPLEX *A, *C;
00271 enum CBLAS_UPLO uplo;
00272 enum CBLAS_TRANSPOSE trans;
00273
00274 get_uplo_type(uplow,&uplo);
00275 get_transpose_type(transp,&trans);
00276
00277 if (*order == TEST_ROW_MJR) {
00278 if (trans == CblasNoTrans) {
00279 LDA = *k+1;
00280 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00281 for( i=0; i<*n; i++ )
00282 for( j=0; j<*k; j++ ) {
00283 A[i*LDA+j].real=a[j*(*lda)+i].real;
00284 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00285 }
00286 }
00287 else{
00288 LDA = *n+1;
00289 A=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00290 for( i=0; i<*k; i++ )
00291 for( j=0; j<*n; j++ ) {
00292 A[i*LDA+j].real=a[j*(*lda)+i].real;
00293 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00294 }
00295 }
00296 LDC = *n+1;
00297 C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
00298 for( i=0; i<*n; i++ )
00299 for( j=0; j<*n; j++ ) {
00300 C[i*LDC+j].real=c[j*(*ldc)+i].real;
00301 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
00302 }
00303 cblas_csyrk(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA, beta,
00304 C, LDC );
00305 for( j=0; j<*n; j++ )
00306 for( i=0; i<*n; i++ ) {
00307 c[j*(*ldc)+i].real=C[i*LDC+j].real;
00308 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
00309 }
00310 free(A);
00311 free(C);
00312 }
00313 else if (*order == TEST_COL_MJR)
00314 cblas_csyrk(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta,
00315 c, *ldc );
00316 else
00317 cblas_csyrk(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, beta,
00318 c, *ldc );
00319 }
00320 void F77_cher2k(int *order, char *uplow, char *transp, int *n, int *k,
00321 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00322 CBLAS_TEST_COMPLEX *b, int *ldb, float *beta,
00323 CBLAS_TEST_COMPLEX *c, int *ldc ) {
00324 int i,j,LDA,LDB,LDC;
00325 CBLAS_TEST_COMPLEX *A, *B, *C;
00326 enum CBLAS_UPLO uplo;
00327 enum CBLAS_TRANSPOSE trans;
00328
00329 get_uplo_type(uplow,&uplo);
00330 get_transpose_type(transp,&trans);
00331
00332 if (*order == TEST_ROW_MJR) {
00333 if (trans == CblasNoTrans) {
00334 LDA = *k+1;
00335 LDB = *k+1;
00336 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ));
00337 B=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_COMPLEX ));
00338 for( i=0; i<*n; i++ )
00339 for( j=0; j<*k; j++ ) {
00340 A[i*LDA+j].real=a[j*(*lda)+i].real;
00341 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00342 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00343 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00344 }
00345 }
00346 else {
00347 LDA = *n+1;
00348 LDB = *n+1;
00349 A=(CBLAS_TEST_COMPLEX* )malloc( LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX ) );
00350 B=(CBLAS_TEST_COMPLEX* )malloc( LDB*(*k)*sizeof(CBLAS_TEST_COMPLEX ) );
00351 for( i=0; i<*k; i++ )
00352 for( j=0; j<*n; j++ ){
00353 A[i*LDA+j].real=a[j*(*lda)+i].real;
00354 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00355 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00356 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00357 }
00358 }
00359 LDC = *n+1;
00360 C=(CBLAS_TEST_COMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_COMPLEX ) );
00361 for( i=0; i<*n; i++ )
00362 for( j=0; j<*n; j++ ) {
00363 C[i*LDC+j].real=c[j*(*ldc)+i].real;
00364 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
00365 }
00366 cblas_cher2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
00367 B, LDB, *beta, C, LDC );
00368 for( j=0; j<*n; j++ )
00369 for( i=0; i<*n; i++ ) {
00370 c[j*(*ldc)+i].real=C[i*LDC+j].real;
00371 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
00372 }
00373 free(A);
00374 free(B);
00375 free(C);
00376 }
00377 else if (*order == TEST_COL_MJR)
00378 cblas_cher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
00379 b, *ldb, *beta, c, *ldc );
00380 else
00381 cblas_cher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
00382 b, *ldb, *beta, c, *ldc );
00383 }
00384 void F77_csyr2k(int *order, char *uplow, char *transp, int *n, int *k,
00385 CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
00386 CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
00387 CBLAS_TEST_COMPLEX *c, int *ldc ) {
00388 int i,j,LDA,LDB,LDC;
00389 CBLAS_TEST_COMPLEX *A, *B, *C;
00390 enum CBLAS_UPLO uplo;
00391 enum CBLAS_TRANSPOSE trans;
00392
00393 get_uplo_type(uplow,&uplo);
00394 get_transpose_type(transp,&trans);
00395
00396 if (*order == TEST_ROW_MJR) {
00397 if (trans == CblasNoTrans) {
00398 LDA = *k+1;
00399 LDB = *k+1;
00400 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00401 B=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_COMPLEX));
00402 for( i=0; i<*n; i++ )
00403 for( j=0; j<*k; j++ ) {
00404 A[i*LDA+j].real=a[j*(*lda)+i].real;
00405 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00406 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00407 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00408 }
00409 }
00410 else {
00411 LDA = *n+1;
00412 LDB = *n+1;
00413 A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
00414 B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*k)*sizeof(CBLAS_TEST_COMPLEX));
00415 for( i=0; i<*k; i++ )
00416 for( j=0; j<*n; j++ ){
00417 A[i*LDA+j].real=a[j*(*lda)+i].real;
00418 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00419 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00420 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00421 }
00422 }
00423 LDC = *n+1;
00424 C=(CBLAS_TEST_COMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_COMPLEX));
00425 for( i=0; i<*n; i++ )
00426 for( j=0; j<*n; j++ ) {
00427 C[i*LDC+j].real=c[j*(*ldc)+i].real;
00428 C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
00429 }
00430 cblas_csyr2k(CblasRowMajor, uplo, trans, *n, *k, alpha, A, LDA,
00431 B, LDB, beta, C, LDC );
00432 for( j=0; j<*n; j++ )
00433 for( i=0; i<*n; i++ ) {
00434 c[j*(*ldc)+i].real=C[i*LDC+j].real;
00435 c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
00436 }
00437 free(A);
00438 free(B);
00439 free(C);
00440 }
00441 else if (*order == TEST_COL_MJR)
00442 cblas_csyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
00443 b, *ldb, beta, c, *ldc );
00444 else
00445 cblas_csyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
00446 b, *ldb, beta, c, *ldc );
00447 }
00448 void F77_ctrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
00449 int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
00450 int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) {
00451 int i,j,LDA,LDB;
00452 CBLAS_TEST_COMPLEX *A, *B;
00453 enum CBLAS_SIDE side;
00454 enum CBLAS_DIAG diag;
00455 enum CBLAS_UPLO uplo;
00456 enum CBLAS_TRANSPOSE trans;
00457
00458 get_uplo_type(uplow,&uplo);
00459 get_transpose_type(transp,&trans);
00460 get_diag_type(diagn,&diag);
00461 get_side_type(rtlf,&side);
00462
00463 if (*order == TEST_ROW_MJR) {
00464 if (side == CblasLeft) {
00465 LDA = *m+1;
00466 A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00467 for( i=0; i<*m; i++ )
00468 for( j=0; j<*m; j++ ) {
00469 A[i*LDA+j].real=a[j*(*lda)+i].real;
00470 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00471 }
00472 }
00473 else{
00474 LDA = *n+1;
00475 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00476 for( i=0; i<*n; i++ )
00477 for( j=0; j<*n; j++ ) {
00478 A[i*LDA+j].real=a[j*(*lda)+i].real;
00479 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00480 }
00481 }
00482 LDB = *n+1;
00483 B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX));
00484 for( i=0; i<*m; i++ )
00485 for( j=0; j<*n; j++ ) {
00486 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00487 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00488 }
00489 cblas_ctrmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha,
00490 A, LDA, B, LDB );
00491 for( j=0; j<*n; j++ )
00492 for( i=0; i<*m; i++ ) {
00493 b[j*(*ldb)+i].real=B[i*LDB+j].real;
00494 b[j*(*ldb)+i].imag=B[i*LDB+j].imag;
00495 }
00496 free(A);
00497 free(B);
00498 }
00499 else if (*order == TEST_COL_MJR)
00500 cblas_ctrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
00501 a, *lda, b, *ldb);
00502 else
00503 cblas_ctrmm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
00504 a, *lda, b, *ldb);
00505 }
00506
00507 void F77_ctrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
00508 int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
00509 int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) {
00510 int i,j,LDA,LDB;
00511 CBLAS_TEST_COMPLEX *A, *B;
00512 enum CBLAS_SIDE side;
00513 enum CBLAS_DIAG diag;
00514 enum CBLAS_UPLO uplo;
00515 enum CBLAS_TRANSPOSE trans;
00516
00517 get_uplo_type(uplow,&uplo);
00518 get_transpose_type(transp,&trans);
00519 get_diag_type(diagn,&diag);
00520 get_side_type(rtlf,&side);
00521
00522 if (*order == TEST_ROW_MJR) {
00523 if (side == CblasLeft) {
00524 LDA = *m+1;
00525 A=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
00526 for( i=0; i<*m; i++ )
00527 for( j=0; j<*m; j++ ) {
00528 A[i*LDA+j].real=a[j*(*lda)+i].real;
00529 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00530 }
00531 }
00532 else{
00533 LDA = *n+1;
00534 A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
00535 for( i=0; i<*n; i++ )
00536 for( j=0; j<*n; j++ ) {
00537 A[i*LDA+j].real=a[j*(*lda)+i].real;
00538 A[i*LDA+j].imag=a[j*(*lda)+i].imag;
00539 }
00540 }
00541 LDB = *n+1;
00542 B=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_COMPLEX));
00543 for( i=0; i<*m; i++ )
00544 for( j=0; j<*n; j++ ) {
00545 B[i*LDB+j].real=b[j*(*ldb)+i].real;
00546 B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
00547 }
00548 cblas_ctrsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, alpha,
00549 A, LDA, B, LDB );
00550 for( j=0; j<*n; j++ )
00551 for( i=0; i<*m; i++ ) {
00552 b[j*(*ldb)+i].real=B[i*LDB+j].real;
00553 b[j*(*ldb)+i].imag=B[i*LDB+j].imag;
00554 }
00555 free(A);
00556 free(B);
00557 }
00558 else if (*order == TEST_COL_MJR)
00559 cblas_ctrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
00560 a, *lda, b, *ldb);
00561 else
00562 cblas_ctrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
00563 a, *lda, b, *ldb);
00564 }