c_sblas3.c
Go to the documentation of this file.
00001 /*
00002  *     Written by D.P. Manley, Digital Equipment Corporation.
00003  *     Prefixed "C_" to BLAS routines and their declarations.
00004  *
00005  *     Modified by T. H. Do, 2/19/98, SGI/CRAY Research.
00006  */
00007 #include <stdio.h>
00008 #include <stdlib.h>
00009 #include "cblas.h"
00010 #include "cblas_test.h"
00011 
00012 void F77_sgemm(int *order, char *transpa, char *transpb, int *m, int *n, 
00013               int *k, float *alpha, float *a, int *lda, float *b, int *ldb,
00014               float *beta, float *c, int *ldc ) {
00015 
00016   float *A, *B, *C;
00017   int i,j,LDA, LDB, LDC;
00018   enum CBLAS_TRANSPOSE transa, transb;
00019 
00020   get_transpose_type(transpa, &transa);
00021   get_transpose_type(transpb, &transb);
00022 
00023   if (*order == TEST_ROW_MJR) {
00024      if (transa == CblasNoTrans) {
00025         LDA = *k+1;
00026         A = (float *)malloc( (*m)*LDA*sizeof( float ) );
00027         for( i=0; i<*m; i++ )
00028            for( j=0; j<*k; j++ )
00029               A[i*LDA+j]=a[j*(*lda)+i];
00030      }
00031      else {
00032         LDA = *m+1;
00033         A   = ( float* )malloc( LDA*(*k)*sizeof( float ) );
00034         for( i=0; i<*k; i++ )
00035            for( j=0; j<*m; j++ )
00036               A[i*LDA+j]=a[j*(*lda)+i];
00037      }
00038      if (transb == CblasNoTrans) {
00039         LDB = *n+1;
00040         B   = ( float* )malloc( (*k)*LDB*sizeof( float ) );
00041         for( i=0; i<*k; i++ )
00042            for( j=0; j<*n; j++ )
00043               B[i*LDB+j]=b[j*(*ldb)+i];
00044      }
00045      else {
00046         LDB = *k+1;
00047         B   = ( float* )malloc( LDB*(*n)*sizeof( float ) );
00048         for( i=0; i<*n; i++ )
00049            for( j=0; j<*k; j++ )
00050               B[i*LDB+j]=b[j*(*ldb)+i];
00051      }
00052      LDC = *n+1;
00053      C   = ( float* )malloc( (*m)*LDC*sizeof( float ) );
00054      for( j=0; j<*n; j++ )
00055         for( i=0; i<*m; i++ )
00056            C[i*LDC+j]=c[j*(*ldc)+i];
00057      cblas_sgemm( CblasRowMajor, transa, transb, *m, *n, *k, *alpha, A, LDA,
00058                   B, LDB, *beta, C, LDC );
00059      for( j=0; j<*n; j++ )
00060         for( i=0; i<*m; i++ )
00061            c[j*(*ldc)+i]=C[i*LDC+j];
00062      free(A);
00063      free(B);
00064      free(C);
00065   }
00066   else if (*order == TEST_COL_MJR)
00067      cblas_sgemm( CblasColMajor, transa, transb, *m, *n, *k, *alpha, a, *lda,
00068                   b, *ldb, *beta, c, *ldc );
00069   else
00070      cblas_sgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
00071                   b, *ldb, *beta, c, *ldc );
00072 }
00073 void F77_ssymm(int *order, char *rtlf, char *uplow, int *m, int *n,
00074               float *alpha, float *a, int *lda, float *b, int *ldb,
00075               float *beta, float *c, int *ldc ) {
00076 
00077   float *A, *B, *C;
00078   int i,j,LDA, LDB, LDC;
00079   enum CBLAS_UPLO uplo;
00080   enum CBLAS_SIDE side;
00081 
00082   get_uplo_type(uplow,&uplo);
00083   get_side_type(rtlf,&side);
00084 
00085   if (*order == TEST_ROW_MJR) {
00086      if (side == CblasLeft) {
00087         LDA = *m+1;
00088         A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
00089         for( i=0; i<*m; i++ )
00090            for( j=0; j<*m; j++ )
00091               A[i*LDA+j]=a[j*(*lda)+i];
00092      }
00093      else{
00094         LDA = *n+1;
00095         A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00096         for( i=0; i<*n; i++ )
00097            for( j=0; j<*n; j++ )
00098               A[i*LDA+j]=a[j*(*lda)+i];
00099      }
00100      LDB = *n+1;
00101      B   = ( float* )malloc( (*m)*LDB*sizeof( float ) );
00102      for( i=0; i<*m; i++ )
00103         for( j=0; j<*n; j++ )
00104            B[i*LDB+j]=b[j*(*ldb)+i];
00105      LDC = *n+1;
00106      C   = ( float* )malloc( (*m)*LDC*sizeof( float ) );
00107      for( j=0; j<*n; j++ )
00108         for( i=0; i<*m; i++ )
00109            C[i*LDC+j]=c[j*(*ldc)+i];
00110      cblas_ssymm( CblasRowMajor, side, uplo, *m, *n, *alpha, A, LDA, B, LDB, 
00111                   *beta, C, LDC );
00112      for( j=0; j<*n; j++ )
00113         for( i=0; i<*m; i++ )
00114            c[j*(*ldc)+i]=C[i*LDC+j];
00115      free(A);
00116      free(B);
00117      free(C);
00118   }
00119   else if (*order == TEST_COL_MJR)
00120      cblas_ssymm( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, 
00121                   *beta, c, *ldc );
00122   else
00123      cblas_ssymm( UNDEFINED, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb, 
00124                   *beta, c, *ldc );
00125 }
00126 
00127 void F77_ssyrk(int *order, char *uplow, char *transp, int *n, int *k,
00128               float *alpha, float *a, int *lda, 
00129               float *beta, float *c, int *ldc ) {
00130 
00131   int i,j,LDA,LDC;
00132   float *A, *C;
00133   enum CBLAS_UPLO uplo;
00134   enum CBLAS_TRANSPOSE trans;
00135 
00136   get_uplo_type(uplow,&uplo);
00137   get_transpose_type(transp,&trans);
00138 
00139   if (*order == TEST_ROW_MJR) {
00140      if (trans == CblasNoTrans) {
00141         LDA = *k+1;
00142         A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00143         for( i=0; i<*n; i++ )
00144            for( j=0; j<*k; j++ )
00145               A[i*LDA+j]=a[j*(*lda)+i];
00146      }
00147      else{
00148         LDA = *n+1;
00149         A   = ( float* )malloc( (*k)*LDA*sizeof( float ) );
00150         for( i=0; i<*k; i++ )
00151            for( j=0; j<*n; j++ )
00152               A[i*LDA+j]=a[j*(*lda)+i];
00153      }
00154      LDC = *n+1;
00155      C   = ( float* )malloc( (*n)*LDC*sizeof( float ) );
00156      for( i=0; i<*n; i++ )
00157         for( j=0; j<*n; j++ )
00158            C[i*LDC+j]=c[j*(*ldc)+i];
00159      cblas_ssyrk(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, *beta, 
00160                  C, LDC );
00161      for( j=0; j<*n; j++ )
00162         for( i=0; i<*n; i++ )
00163            c[j*(*ldc)+i]=C[i*LDC+j];
00164      free(A);
00165      free(C);
00166   }
00167   else if (*order == TEST_COL_MJR)
00168      cblas_ssyrk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta, 
00169                  c, *ldc );
00170   else
00171      cblas_ssyrk(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, *beta, 
00172                  c, *ldc );
00173 }
00174 
00175 void F77_ssyr2k(int *order, char *uplow, char *transp, int *n, int *k,
00176                float *alpha, float *a, int *lda, float *b, int *ldb,
00177                float *beta, float *c, int *ldc ) {
00178   int i,j,LDA,LDB,LDC;
00179   float *A, *B, *C;
00180   enum CBLAS_UPLO uplo;
00181   enum CBLAS_TRANSPOSE trans;
00182 
00183   get_uplo_type(uplow,&uplo);
00184   get_transpose_type(transp,&trans);
00185 
00186   if (*order == TEST_ROW_MJR) {
00187      if (trans == CblasNoTrans) {
00188         LDA = *k+1;
00189         LDB = *k+1;
00190         A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00191         B   = ( float* )malloc( (*n)*LDB*sizeof( float ) );
00192         for( i=0; i<*n; i++ )
00193            for( j=0; j<*k; j++ ) {
00194               A[i*LDA+j]=a[j*(*lda)+i];
00195               B[i*LDB+j]=b[j*(*ldb)+i];
00196            }
00197      }
00198      else {
00199         LDA = *n+1;
00200         LDB = *n+1;
00201         A   = ( float* )malloc( LDA*(*k)*sizeof( float ) );
00202         B   = ( float* )malloc( LDB*(*k)*sizeof( float ) );
00203         for( i=0; i<*k; i++ )
00204            for( j=0; j<*n; j++ ){
00205               A[i*LDA+j]=a[j*(*lda)+i];
00206               B[i*LDB+j]=b[j*(*ldb)+i];
00207            }
00208      }
00209      LDC = *n+1;
00210      C   = ( float* )malloc( (*n)*LDC*sizeof( float ) );
00211      for( i=0; i<*n; i++ )
00212         for( j=0; j<*n; j++ )
00213            C[i*LDC+j]=c[j*(*ldc)+i];
00214      cblas_ssyr2k(CblasRowMajor, uplo, trans, *n, *k, *alpha, A, LDA, 
00215                   B, LDB, *beta, C, LDC );
00216      for( j=0; j<*n; j++ )
00217         for( i=0; i<*n; i++ )
00218            c[j*(*ldc)+i]=C[i*LDC+j];
00219      free(A);
00220      free(B);
00221      free(C);
00222   }
00223   else if (*order == TEST_COL_MJR)
00224      cblas_ssyr2k(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, 
00225                    b, *ldb, *beta, c, *ldc );
00226   else
00227      cblas_ssyr2k(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda, 
00228                    b, *ldb, *beta, c, *ldc );
00229 }
00230 void F77_strmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
00231               int *m, int *n, float *alpha, float *a, int *lda, float *b, 
00232               int *ldb) {
00233   int i,j,LDA,LDB;
00234   float *A, *B;
00235   enum CBLAS_SIDE side;
00236   enum CBLAS_DIAG diag;
00237   enum CBLAS_UPLO uplo;
00238   enum CBLAS_TRANSPOSE trans;
00239 
00240   get_uplo_type(uplow,&uplo);
00241   get_transpose_type(transp,&trans);
00242   get_diag_type(diagn,&diag);
00243   get_side_type(rtlf,&side);
00244 
00245   if (*order == TEST_ROW_MJR) {
00246      if (side == CblasLeft) {
00247         LDA = *m+1;
00248         A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
00249         for( i=0; i<*m; i++ )
00250            for( j=0; j<*m; j++ )
00251               A[i*LDA+j]=a[j*(*lda)+i];
00252      }
00253      else{
00254         LDA = *n+1;
00255         A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00256         for( i=0; i<*n; i++ )
00257            for( j=0; j<*n; j++ )
00258               A[i*LDA+j]=a[j*(*lda)+i];
00259      }
00260      LDB = *n+1;
00261      B   = ( float* )malloc( (*m)*LDB*sizeof( float ) );
00262      for( i=0; i<*m; i++ )
00263         for( j=0; j<*n; j++ )
00264            B[i*LDB+j]=b[j*(*ldb)+i];
00265      cblas_strmm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha, 
00266                  A, LDA, B, LDB );
00267      for( j=0; j<*n; j++ )
00268         for( i=0; i<*m; i++ )
00269            b[j*(*ldb)+i]=B[i*LDB+j];
00270      free(A);
00271      free(B);
00272   }
00273   else if (*order == TEST_COL_MJR)
00274      cblas_strmm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha, 
00275                    a, *lda, b, *ldb);
00276   else
00277      cblas_strmm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha, 
00278                    a, *lda, b, *ldb);
00279 }
00280 
00281 void F77_strsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
00282               int *m, int *n, float *alpha, float *a, int *lda, float *b,
00283               int *ldb) {
00284   int i,j,LDA,LDB;
00285   float *A, *B;
00286   enum CBLAS_SIDE side;
00287   enum CBLAS_DIAG diag;
00288   enum CBLAS_UPLO uplo;
00289   enum CBLAS_TRANSPOSE trans;
00290 
00291   get_uplo_type(uplow,&uplo);
00292   get_transpose_type(transp,&trans);
00293   get_diag_type(diagn,&diag);
00294   get_side_type(rtlf,&side);
00295 
00296   if (*order == TEST_ROW_MJR) {
00297      if (side == CblasLeft) {
00298         LDA = *m+1;
00299         A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
00300         for( i=0; i<*m; i++ )
00301            for( j=0; j<*m; j++ )
00302               A[i*LDA+j]=a[j*(*lda)+i];
00303      }
00304      else{
00305         LDA = *n+1;
00306         A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
00307         for( i=0; i<*n; i++ )
00308            for( j=0; j<*n; j++ )
00309               A[i*LDA+j]=a[j*(*lda)+i];
00310      }
00311      LDB = *n+1;
00312      B   = ( float* )malloc( (*m)*LDB*sizeof( float ) );
00313      for( i=0; i<*m; i++ )
00314         for( j=0; j<*n; j++ )
00315            B[i*LDB+j]=b[j*(*ldb)+i];
00316      cblas_strsm(CblasRowMajor, side, uplo, trans, diag, *m, *n, *alpha, 
00317                  A, LDA, B, LDB );
00318      for( j=0; j<*n; j++ )
00319         for( i=0; i<*m; i++ )
00320            b[j*(*ldb)+i]=B[i*LDB+j];
00321      free(A);
00322      free(B);
00323   }
00324   else if (*order == TEST_COL_MJR)
00325      cblas_strsm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha, 
00326                    a, *lda, b, *ldb);
00327   else
00328      cblas_strsm(UNDEFINED, side, uplo, trans, diag, *m, *n, *alpha, 
00329                    a, *lda, b, *ldb);
00330 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:15