ctest/c_zblas3_3m.c

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