Update CBLAS3 tests from Reference-LAPACK to add GEMMT(R) testing

ctest/c_cblas3.c

@@ -5,26 +5,29 @@
  *     Modified by T. H. Do, 4/15/98, SGI/CRAY Research.
  */
 #include <stdlib.h>
-#include "common.h"
+#include "cblas.h"
 #include "cblas_test.h"
-
 #define  TEST_COL_MJR	0
 #define  TEST_ROW_MJR	1
 #define  UNDEFINED     -1
 
-void F77_cgemm(int *order, char *transpa, char *transpb, int *m, int *n,
+void F77_cgemm(int *layout, char *transpa, char *transpb, int *m, int *n,
      int *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
      CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
-     CBLAS_TEST_COMPLEX *c, int *ldc ) {
+     CBLAS_TEST_COMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
+#endif
+) {
 
   CBLAS_TEST_COMPLEX *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_TRANSPOSE transa, transb;
+  CBLAS_TRANSPOSE transa, transb;
 
   get_transpose_type(transpa, &transa);
   get_transpose_type(transpb, &transb);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (transa == CblasNoTrans) {
         LDA = *k+1;
         A=(CBLAS_TEST_COMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
@@ -81,7 +84,7 @@ void F77_cgemm(int *order, char *transpa, char *transpb, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_cgemm( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda,
                   b, *ldb, beta, c, *ldc );
   else
@@ -89,20 +92,104 @@ void F77_cgemm(int *order, char *transpa, char *transpb, int *m, int *n,
                   b, *ldb, beta, c, *ldc );
 }
 
-void F77_chemm(int *order, char *rtlf, char *uplow, int *m, int *n,
+void F77_cgemmtr(int *layout, char *uplop, char *transpa, char *transpb, int *n,
+     int *k, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
+     CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
+     CBLAS_TEST_COMPLEX *c, int *ldc ) {
+
+  CBLAS_TEST_COMPLEX *A, *B, *C;
+  int i,j,LDA, LDB, LDC;
+  CBLAS_TRANSPOSE transa, transb;
+  CBLAS_UPLO uplo;
+
+  get_transpose_type(transpa, &transa);
+  get_transpose_type(transpb, &transb);
+  get_uplo_type(uplop, &uplo);
+
+  if (*layout == TEST_ROW_MJR) {
+     if (transa == CblasNoTrans) {
+        LDA = *k+1;
+        A=(CBLAS_TEST_COMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
+        for( i=0; i<*n; i++ )
+           for( j=0; j<*k; j++ ) {
+              A[i*LDA+j].real=a[j*(*lda)+i].real;
+              A[i*LDA+j].imag=a[j*(*lda)+i].imag;
+           }
+     }
+     else {
+        LDA = *n+1;
+        A=(CBLAS_TEST_COMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_COMPLEX));
+        for( i=0; i<*k; i++ )
+           for( j=0; j<*n; j++ ) {
+              A[i*LDA+j].real=a[j*(*lda)+i].real;
+              A[i*LDA+j].imag=a[j*(*lda)+i].imag;
+           }
+     }
+
+     if (transb == CblasNoTrans) {
+        LDB = *n+1;
+        B=(CBLAS_TEST_COMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_COMPLEX) );
+        for( i=0; i<*k; i++ )
+           for( j=0; j<*n; j++ ) {
+              B[i*LDB+j].real=b[j*(*ldb)+i].real;
+              B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
+           }
+     }
+     else {
+        LDB = *k+1;
+        B=(CBLAS_TEST_COMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_COMPLEX));
+        for( i=0; i<*n; i++ )
+           for( j=0; j<*k; j++ ) {
+              B[i*LDB+j].real=b[j*(*ldb)+i].real;
+              B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
+           }
+     }
+
+     LDC = *n+1;
+     C=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_COMPLEX));
+     for( j=0; j<*n; j++ )
+        for( i=0; i<*n; i++ ) {
+           C[i*LDC+j].real=c[j*(*ldc)+i].real;
+           C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
+        }
+     cblas_cgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA,
+                  B, LDB, beta, C, LDC );
+     for( j=0; j<*n; j++ )
+        for( i=0; i<*n; i++ ) {
+           c[j*(*ldc)+i].real=C[i*LDC+j].real;
+           c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
+        }
+     free(A);
+     free(B);
+     free(C);
+  }
+  else if (*layout == TEST_COL_MJR)
+     cblas_cgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda,
+                  b, *ldb, beta, c, *ldc );
+  else
+     cblas_cgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda,
+                  b, *ldb, beta, c, *ldc );
+}
+
+
+void F77_chemm(int *layout, char *rtlf, char *uplow, int *m, int *n,
         CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
-	CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
-        CBLAS_TEST_COMPLEX *c, int *ldc ) {
+	      CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
+        CBLAS_TEST_COMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
+#endif
+) {
 
   CBLAS_TEST_COMPLEX *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_SIDE side;
+  CBLAS_UPLO uplo;
+  CBLAS_SIDE side;
 
   get_uplo_type(uplow,&uplo);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
         A= (CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
@@ -146,27 +233,31 @@ void F77_chemm(int *order, char *rtlf, char *uplow, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_chemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
                   beta, c, *ldc );
   else
      cblas_chemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
                   beta, c, *ldc );
 }
-void F77_csymm(int *order, char *rtlf, char *uplow, int *m, int *n,
+void F77_csymm(int *layout, char *rtlf, char *uplow, int *m, int *n,
           CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
-	  CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
-          CBLAS_TEST_COMPLEX *c, int *ldc ) {
+	        CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
+          CBLAS_TEST_COMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
+#endif
+) {
 
   CBLAS_TEST_COMPLEX *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_SIDE side;
+  CBLAS_UPLO uplo;
+  CBLAS_SIDE side;
 
   get_uplo_type(uplow,&uplo);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
         A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
@@ -200,7 +291,7 @@ void F77_csymm(int *order, char *rtlf, char *uplow, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_csymm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
                   beta, c, *ldc );
   else
@@ -208,19 +299,23 @@ void F77_csymm(int *order, char *rtlf, char *uplow, int *m, int *n,
                   beta, c, *ldc );
 }
 
-void F77_cherk(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_cherk(int *layout, char *uplow, char *transp, int *n, int *k,
      float *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
-     float *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) {
+     float *beta, CBLAS_TEST_COMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
 
   int i,j,LDA,LDC;
   CBLAS_TEST_COMPLEX *A, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
@@ -256,7 +351,7 @@ void F77_cherk(int *order, char *uplow, char *transp, int *n, int *k,
      free(A);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_cherk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
 	         c, *ldc );
   else
@@ -264,19 +359,23 @@ void F77_cherk(int *order, char *uplow, char *transp, int *n, int *k,
 	         c, *ldc );
 }
 
-void F77_csyrk(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_csyrk(int *layout, char *uplow, char *transp, int *n, int *k,
      CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
-     CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, int *ldc ) {
+     CBLAS_TEST_COMPLEX *beta, CBLAS_TEST_COMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
 
   int i,j,LDA,LDC;
   CBLAS_TEST_COMPLEX *A, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         A=(CBLAS_TEST_COMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_COMPLEX));
@@ -312,26 +411,30 @@ void F77_csyrk(int *order, char *uplow, char *transp, int *n, int *k,
      free(A);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_csyrk(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta,
 	         c, *ldc );
   else
      cblas_csyrk(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, beta,
 	         c, *ldc );
 }
-void F77_cher2k(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_cher2k(int *layout, char *uplow, char *transp, int *n, int *k,
         CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
 	CBLAS_TEST_COMPLEX *b, int *ldb, float *beta,
-        CBLAS_TEST_COMPLEX *c, int *ldc ) {
+        CBLAS_TEST_COMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
   int i,j,LDA,LDB,LDC;
   CBLAS_TEST_COMPLEX *A, *B, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         LDB = *k+1;
@@ -376,26 +479,30 @@ void F77_cher2k(int *order, char *uplow, char *transp, int *n, int *k,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_cher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
   else
      cblas_cher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
 }
-void F77_csyr2k(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_csyr2k(int *layout, char *uplow, char *transp, int *n, int *k,
          CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a, int *lda,
 	 CBLAS_TEST_COMPLEX *b, int *ldb, CBLAS_TEST_COMPLEX *beta,
-         CBLAS_TEST_COMPLEX *c, int *ldc ) {
+         CBLAS_TEST_COMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
   int i,j,LDA,LDB,LDC;
   CBLAS_TEST_COMPLEX *A, *B, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         LDB = *k+1;
@@ -440,29 +547,33 @@ void F77_csyr2k(int *order, char *uplow, char *transp, int *n, int *k,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_csyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, beta, c, *ldc );
   else
      cblas_csyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, beta, c, *ldc );
 }
-void F77_ctrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_ctrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
        int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
-       int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) {
+       int *lda, CBLAS_TEST_COMPLEX *b, int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
+#endif
+) {
   int i,j,LDA,LDB;
   CBLAS_TEST_COMPLEX *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
         A=(CBLAS_TEST_COMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_COMPLEX));
@@ -498,7 +609,7 @@ void F77_ctrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_ctrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
 		   a, *lda, b, *ldb);
   else
@@ -506,22 +617,26 @@ void F77_ctrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
 		   a, *lda, b, *ldb);
 }
 
-void F77_ctrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_ctrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
          int *m, int *n, CBLAS_TEST_COMPLEX *alpha, CBLAS_TEST_COMPLEX *a,
-         int *lda, CBLAS_TEST_COMPLEX *b, int *ldb) {
+         int *lda, CBLAS_TEST_COMPLEX *b, int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
+#endif
+) {
   int i,j,LDA,LDB;
   CBLAS_TEST_COMPLEX *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
         A=(CBLAS_TEST_COMPLEX* )malloc( (*m)*LDA*sizeof(CBLAS_TEST_COMPLEX ) );
@@ -557,13 +672,10 @@ void F77_ctrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_ctrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
 		   a, *lda, b, *ldb);
   else
      cblas_ctrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
 		   a, *lda, b, *ldb);
 }
-
-
-

ctest/c_dblas3.c

@@ -5,55 +5,58 @@
  *     Modified by T. H. Do, 2/19/98, SGI/CRAY Research.
  */
 #include <stdlib.h>
-#include "common.h"
+#include "cblas.h"
 #include "cblas_test.h"
-
 #define  TEST_COL_MJR	0
 #define  TEST_ROW_MJR	1
 #define  UNDEFINED     -1
 
-void F77_dgemm(int *order, char *transpa, char *transpb, int *m, int *n,
+void F77_dgemm(int *layout, char *transpa, char *transpb, int *m, int *n,
               int *k, double *alpha, double *a, int *lda, double *b, int *ldb,
-              double *beta, double *c, int *ldc ) {
+              double *beta, double *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
+#endif
+) {
 
   double *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_TRANSPOSE transa, transb;
+  CBLAS_TRANSPOSE transa, transb;
 
   get_transpose_type(transpa, &transa);
   get_transpose_type(transpb, &transb);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (transa == CblasNoTrans) {
         LDA = *k+1;
-        A = (double *)malloc( (*m)*(size_t)LDA*sizeof( double ) );
+        A = (double *)malloc( (*m)*LDA*sizeof( double ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*k; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else {
         LDA = *m+1;
-        A   = ( double* )malloc( (size_t)LDA*(*k)*sizeof( double ) );
+        A   = ( double* )malloc( LDA*(*k)*sizeof( double ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      if (transb == CblasNoTrans) {
         LDB = *n+1;
-        B   = ( double* )malloc( (*k)*(size_t)LDB*sizeof( double ) );
+        B   = ( double* )malloc( (*k)*LDB*sizeof( double ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ )
               B[i*LDB+j]=b[j*(*ldb)+i];
      }
      else {
         LDB = *k+1;
-        B   = ( double* )malloc( (size_t)LDB*(*n)*sizeof( double ) );
+        B   = ( double* )malloc( LDB*(*n)*sizeof( double ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ )
               B[i*LDB+j]=b[j*(*ldb)+i];
      }
      LDC = *n+1;
-     C   = ( double* )malloc( (*m)*(size_t)LDC*sizeof( double ) );
+     C   = ( double* )malloc( (*m)*LDC*sizeof( double ) );
      for( j=0; j<*n; j++ )
         for( i=0; i<*m; i++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -67,47 +70,130 @@ void F77_dgemm(int *order, char *transpa, char *transpb, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_dgemm( CblasColMajor, transa, transb, *m, *n, *k, *alpha, a, *lda,
                   b, *ldb, *beta, c, *ldc );
   else
      cblas_dgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
                   b, *ldb, *beta, c, *ldc );
 }
-void F77_dsymm(int *order, char *rtlf, char *uplow, int *m, int *n,
+
+void F77_dgemmtr(int *layout, char *uplop, char *transpa, char *transpb, int *n,
+     int *k, double *alpha, double *a, int *lda,
+     double *b, int *ldb, double *beta,
+     double *c, int *ldc ) {
+
+  double *A, *B, *C;
+  int i,j,LDA, LDB, LDC;
+  CBLAS_TRANSPOSE transa, transb;
+  CBLAS_UPLO uplo;
+
+  get_transpose_type(transpa, &transa);
+  get_transpose_type(transpb, &transb);
+  get_uplo_type(uplop, &uplo);
+
+  if (*layout == TEST_ROW_MJR) {
+     if (transa == CblasNoTrans) {
+        LDA = *k+1;
+        A=(double*)malloc((*n)*LDA*sizeof(double));
+        for( i=0; i<*n; i++ )
+           for( j=0; j<*k; j++ ) {
+              A[i*LDA+j]=a[j*(*lda)+i];
+           }
+     }
+     else {
+        LDA = *n+1;
+        A=(double* )malloc(LDA*(*k)*sizeof(double));
+        for( i=0; i<*k; i++ )
+           for( j=0; j<*n; j++ ) {
+              A[i*LDA+j]=a[j*(*lda)+i];
+           }
+     }
+
+     if (transb == CblasNoTrans) {
+        LDB = *n+1;
+        B=(double* )malloc((*k)*LDB*sizeof(double) );
+        for( i=0; i<*k; i++ )
+           for( j=0; j<*n; j++ ) {
+              B[i*LDB+j]=b[j*(*ldb)+i];
+           }
+     }
+     else {
+        LDB = *k+1;
+        B=(double* )malloc(LDB*(*n)*sizeof(double));
+        for( i=0; i<*n; i++ )
+           for( j=0; j<*k; j++ ) {
+              B[i*LDB+j]=b[j*(*ldb)+i];
+           }
+     }
+
+     LDC = *n+1;
+     C=(double* )malloc((*n)*LDC*sizeof(double));
+     for( j=0; j<*n; j++ )
+        for( i=0; i<*n; i++ ) {
+           C[i*LDC+j]=c[j*(*ldc)+i];
+        }
+     cblas_dgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA,
+                  B, LDB, *beta, C, LDC );
+     for( j=0; j<*n; j++ )
+        for( i=0; i<*n; i++ ) {
+           c[j*(*ldc)+i]=C[i*LDC+j];
+        }
+     free(A);
+     free(B);
+     free(C);
+  }
+  else if (*layout == TEST_COL_MJR){
+     cblas_dgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda,
+                  b, *ldb, *beta, c, *ldc );
+  }
+  else
+     cblas_dgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda,
+                  b, *ldb, *beta, c, *ldc );
+}
+
+
+
+
+
+void F77_dsymm(int *layout, char *rtlf, char *uplow, int *m, int *n,
               double *alpha, double *a, int *lda, double *b, int *ldb,
-              double *beta, double *c, int *ldc ) {
+              double *beta, double *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
+#endif
+) {
 
   double *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_SIDE side;
+  CBLAS_UPLO uplo;
+  CBLAS_SIDE side;
 
   get_uplo_type(uplow,&uplo);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A   = ( double* )malloc( (*m)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*m)*LDA*sizeof( double ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( double* )malloc( (*n)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDB = *n+1;
-     B   = ( double* )malloc( (*m)*(size_t)LDB*sizeof( double ) );
+     B   = ( double* )malloc( (*m)*LDB*sizeof( double ) );
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ )
            B[i*LDB+j]=b[j*(*ldb)+i];
      LDC = *n+1;
-     C   = ( double* )malloc( (*m)*(size_t)LDC*sizeof( double ) );
+     C   = ( double* )malloc( (*m)*LDC*sizeof( double ) );
      for( j=0; j<*n; j++ )
         for( i=0; i<*m; i++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -120,7 +206,7 @@ void F77_dsymm(int *order, char *rtlf, char *uplow, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_dsymm( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb,
                   *beta, c, *ldc );
   else
@@ -128,35 +214,39 @@ void F77_dsymm(int *order, char *rtlf, char *uplow, int *m, int *n,
                   *beta, c, *ldc );
 }
 
-void F77_dsyrk(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_dsyrk(int *layout, char *uplow, char *transp, int *n, int *k,
               double *alpha, double *a, int *lda,
-              double *beta, double *c, int *ldc ) {
+              double *beta, double *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
 
   int i,j,LDA,LDC;
   double *A, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
-        A   = ( double* )malloc( (*n)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( double* )malloc( (*k)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*k)*LDA*sizeof( double ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDC = *n+1;
-     C   = ( double* )malloc( (*n)*(size_t)LDC*sizeof( double ) );
+     C   = ( double* )malloc( (*n)*LDC*sizeof( double ) );
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -168,7 +258,7 @@ void F77_dsyrk(int *order, char *uplow, char *transp, int *n, int *k,
      free(A);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_dsyrk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
 	         c, *ldc );
   else
@@ -176,23 +266,27 @@ void F77_dsyrk(int *order, char *uplow, char *transp, int *n, int *k,
 	         c, *ldc );
 }
 
-void F77_dsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_dsyr2k(int *layout, char *uplow, char *transp, int *n, int *k,
                double *alpha, double *a, int *lda, double *b, int *ldb,
-               double *beta, double *c, int *ldc ) {
+               double *beta, double *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
   int i,j,LDA,LDB,LDC;
   double *A, *B, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         LDB = *k+1;
-        A   = ( double* )malloc( (*n)*(size_t)LDA*sizeof( double ) );
-        B   = ( double* )malloc( (*n)*(size_t)LDB*sizeof( double ) );
+        A   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
+        B   = ( double* )malloc( (*n)*LDB*sizeof( double ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ ) {
               A[i*LDA+j]=a[j*(*lda)+i];
@@ -202,8 +296,8 @@ void F77_dsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
      else {
         LDA = *n+1;
         LDB = *n+1;
-        A   = ( double* )malloc( (size_t)LDA*(*k)*sizeof( double ) );
-        B   = ( double* )malloc( (size_t)LDB*(*k)*sizeof( double ) );
+        A   = ( double* )malloc( LDA*(*k)*sizeof( double ) );
+        B   = ( double* )malloc( LDB*(*k)*sizeof( double ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ ){
               A[i*LDA+j]=a[j*(*lda)+i];
@@ -211,7 +305,7 @@ void F77_dsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
            }
      }
      LDC = *n+1;
-     C   = ( double* )malloc( (*n)*(size_t)LDC*sizeof( double ) );
+     C   = ( double* )malloc( (*n)*LDC*sizeof( double ) );
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -224,45 +318,49 @@ void F77_dsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_dsyr2k(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
   else
      cblas_dsyr2k(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
 }
-void F77_dtrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_dtrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
               int *m, int *n, double *alpha, double *a, int *lda, double *b,
-              int *ldb) {
+              int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diag_len
+#endif
+) {
   int i,j,LDA,LDB;
   double *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A   = ( double* )malloc( (*m)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*m)*LDA*sizeof( double ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( double* )malloc( (*n)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDB = *n+1;
-     B   = ( double* )malloc( (*m)*(size_t)LDB*sizeof( double ) );
+     B   = ( double* )malloc( (*m)*LDB*sizeof( double ) );
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ )
            B[i*LDB+j]=b[j*(*ldb)+i];
@@ -274,7 +372,7 @@ void F77_dtrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_dtrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
 		   a, *lda, b, *ldb);
   else
@@ -282,38 +380,42 @@ void F77_dtrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
 		   a, *lda, b, *ldb);
 }
 
-void F77_dtrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_dtrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
               int *m, int *n, double *alpha, double *a, int *lda, double *b,
-              int *ldb) {
+              int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
+#endif
+) {
   int i,j,LDA,LDB;
   double *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A   = ( double* )malloc( (*m)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*m)*LDA*sizeof( double ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( double* )malloc( (*n)*(size_t)LDA*sizeof( double ) );
+        A   = ( double* )malloc( (*n)*LDA*sizeof( double ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDB = *n+1;
-     B   = ( double* )malloc( (*m)*(size_t)LDB*sizeof( double ) );
+     B   = ( double* )malloc( (*m)*LDB*sizeof( double ) );
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ )
            B[i*LDB+j]=b[j*(*ldb)+i];
@@ -325,7 +427,7 @@ void F77_dtrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_dtrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
 		   a, *lda, b, *ldb);
   else

ctest/c_sblas3.c

@@ -6,51 +6,55 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
-#include "common.h"
+#include "cblas.h"
 #include "cblas_test.h"
 
-void F77_sgemm(int *order, char *transpa, char *transpb, int *m, int *n,
+void F77_sgemm(int *layout, char *transpa, char *transpb, int *m, int *n,
               int *k, float *alpha, float *a, int *lda, float *b, int *ldb,
-              float *beta, float *c, int *ldc ) {
+              float *beta, float *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
+#endif
+) {
 
   float *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_TRANSPOSE transa, transb;
+  CBLAS_TRANSPOSE transa, transb;
 
   get_transpose_type(transpa, &transa);
   get_transpose_type(transpb, &transb);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (transa == CblasNoTrans) {
         LDA = *k+1;
-        A = (float *)malloc( (*m)*(size_t)LDA*sizeof( float ) );
+        A = (float *)malloc( (*m)*LDA*sizeof( float ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*k; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else {
         LDA = *m+1;
-        A   = ( float* )malloc( (size_t)LDA*(*k)*sizeof( float ) );
+        A   = ( float* )malloc( LDA*(*k)*sizeof( float ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      if (transb == CblasNoTrans) {
         LDB = *n+1;
-        B   = ( float* )malloc( (*k)*(size_t)LDB*sizeof( float ) );
+        B   = ( float* )malloc( (*k)*LDB*sizeof( float ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ )
               B[i*LDB+j]=b[j*(*ldb)+i];
      }
      else {
         LDB = *k+1;
-        B   = ( float* )malloc( (size_t)LDB*(*n)*sizeof( float ) );
+        B   = ( float* )malloc( LDB*(*n)*sizeof( float ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ )
               B[i*LDB+j]=b[j*(*ldb)+i];
      }
      LDC = *n+1;
-     C   = ( float* )malloc( (*m)*(size_t)LDC*sizeof( float ) );
+     C   = ( float* )malloc( (*m)*LDC*sizeof( float ) );
      for( j=0; j<*n; j++ )
         for( i=0; i<*m; i++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -63,47 +67,127 @@ void F77_sgemm(int *order, char *transpa, char *transpb, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_sgemm( CblasColMajor, transa, transb, *m, *n, *k, *alpha, a, *lda,
                   b, *ldb, *beta, c, *ldc );
   else
      cblas_sgemm( UNDEFINED, transa, transb, *m, *n, *k, *alpha, a, *lda,
                   b, *ldb, *beta, c, *ldc );
 }
-void F77_ssymm(int *order, char *rtlf, char *uplow, int *m, int *n,
+
+void F77_sgemmtr(int *layout, char *uplop, char *transpa, char *transpb, int *n,
+     int *k, float *alpha, float *a, int *lda,
+     float *b, int *ldb, float *beta,
+     float *c, int *ldc ) {
+
+  float *A, *B, *C;
+  int i,j,LDA, LDB, LDC;
+  CBLAS_TRANSPOSE transa, transb;
+  CBLAS_UPLO uplo;
+
+  get_transpose_type(transpa, &transa);
+  get_transpose_type(transpb, &transb);
+  get_uplo_type(uplop, &uplo);
+
+  if (*layout == TEST_ROW_MJR) {
+     if (transa == CblasNoTrans) {
+        LDA = *k+1;
+        A=(float*)malloc((*n)*LDA*sizeof(float));
+        for( i=0; i<*n; i++ )
+           for( j=0; j<*k; j++ ) {
+              A[i*LDA+j]=a[j*(*lda)+i];
+           }
+     }
+     else {
+        LDA = *n+1;
+        A=(float* )malloc(LDA*(*k)*sizeof(float));
+        for( i=0; i<*k; i++ )
+           for( j=0; j<*n; j++ ) {
+              A[i*LDA+j]=a[j*(*lda)+i];
+           }
+     }
+
+     if (transb == CblasNoTrans) {
+        LDB = *n+1;
+        B=(float* )malloc((*k)*LDB*sizeof(float) );
+        for( i=0; i<*k; i++ )
+           for( j=0; j<*n; j++ ) {
+              B[i*LDB+j]=b[j*(*ldb)+i];
+           }
+     }
+     else {
+        LDB = *k+1;
+        B=(float* )malloc(LDB*(*n)*sizeof(float));
+        for( i=0; i<*n; i++ )
+           for( j=0; j<*k; j++ ) {
+              B[i*LDB+j]=b[j*(*ldb)+i];
+           }
+     }
+
+     LDC = *n+1;
+     C=(float* )malloc((*n)*LDC*sizeof(float));
+     for( j=0; j<*n; j++ )
+        for( i=0; i<*n; i++ ) {
+           C[i*LDC+j]=c[j*(*ldc)+i];
+        }
+     cblas_sgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, *alpha, A, LDA,
+                  B, LDB, *beta, C, LDC );
+     for( j=0; j<*n; j++ )
+        for( i=0; i<*n; i++ ) {
+           c[j*(*ldc)+i]=C[i*LDC+j];
+        }
+     free(A);
+     free(B);
+     free(C);
+  }
+  else if (*layout == TEST_COL_MJR)
+     cblas_sgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, *alpha, a, *lda,
+                  b, *ldb, *beta, c, *ldc );
+  else
+     cblas_sgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, *alpha, a, *lda,
+                  b, *ldb, *beta, c, *ldc );
+}
+
+
+
+void F77_ssymm(int *layout, char *rtlf, char *uplow, int *m, int *n,
               float *alpha, float *a, int *lda, float *b, int *ldb,
-              float *beta, float *c, int *ldc ) {
+              float *beta, float *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
+#endif
+) {
 
   float *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_SIDE side;
+  CBLAS_UPLO uplo;
+  CBLAS_SIDE side;
 
   get_uplo_type(uplow,&uplo);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A   = ( float* )malloc( (*m)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( float* )malloc( (*n)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDB = *n+1;
-     B   = ( float* )malloc( (*m)*(size_t)LDB*sizeof( float ) );
+     B   = ( float* )malloc( (*m)*LDB*sizeof( float ) );
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ )
            B[i*LDB+j]=b[j*(*ldb)+i];
      LDC = *n+1;
-     C   = ( float* )malloc( (*m)*(size_t)LDC*sizeof( float ) );
+     C   = ( float* )malloc( (*m)*LDC*sizeof( float ) );
      for( j=0; j<*n; j++ )
         for( i=0; i<*m; i++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -116,7 +200,7 @@ void F77_ssymm(int *order, char *rtlf, char *uplow, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_ssymm( CblasColMajor, side, uplo, *m, *n, *alpha, a, *lda, b, *ldb,
                   *beta, c, *ldc );
   else
@@ -124,35 +208,39 @@ void F77_ssymm(int *order, char *rtlf, char *uplow, int *m, int *n,
                   *beta, c, *ldc );
 }
 
-void F77_ssyrk(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_ssyrk(int *layout, char *uplow, char *transp, int *n, int *k,
               float *alpha, float *a, int *lda,
-              float *beta, float *c, int *ldc ) {
+              float *beta, float *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
 
   int i,j,LDA,LDC;
   float *A, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
-        A   = ( float* )malloc( (*n)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( float* )malloc( (*k)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*k)*LDA*sizeof( float ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDC = *n+1;
-     C   = ( float* )malloc( (*n)*(size_t)LDC*sizeof( float ) );
+     C   = ( float* )malloc( (*n)*LDC*sizeof( float ) );
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -164,7 +252,7 @@ void F77_ssyrk(int *order, char *uplow, char *transp, int *n, int *k,
      free(A);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_ssyrk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
 	         c, *ldc );
   else
@@ -172,23 +260,27 @@ void F77_ssyrk(int *order, char *uplow, char *transp, int *n, int *k,
 	         c, *ldc );
 }
 
-void F77_ssyr2k(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_ssyr2k(int *layout, char *uplow, char *transp, int *n, int *k,
                float *alpha, float *a, int *lda, float *b, int *ldb,
-               float *beta, float *c, int *ldc ) {
+               float *beta, float *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
   int i,j,LDA,LDB,LDC;
   float *A, *B, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         LDB = *k+1;
-        A   = ( float* )malloc( (*n)*(size_t)LDA*sizeof( float ) );
-        B   = ( float* )malloc( (*n)*(size_t)LDB*sizeof( float ) );
+        A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
+        B   = ( float* )malloc( (*n)*LDB*sizeof( float ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ ) {
               A[i*LDA+j]=a[j*(*lda)+i];
@@ -198,8 +290,8 @@ void F77_ssyr2k(int *order, char *uplow, char *transp, int *n, int *k,
      else {
         LDA = *n+1;
         LDB = *n+1;
-        A   = ( float* )malloc( (size_t)LDA*(*k)*sizeof( float ) );
-        B   = ( float* )malloc( (size_t)LDB*(*k)*sizeof( float ) );
+        A   = ( float* )malloc( LDA*(*k)*sizeof( float ) );
+        B   = ( float* )malloc( LDB*(*k)*sizeof( float ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ ){
               A[i*LDA+j]=a[j*(*lda)+i];
@@ -207,7 +299,7 @@ void F77_ssyr2k(int *order, char *uplow, char *transp, int *n, int *k,
            }
      }
      LDC = *n+1;
-     C   = ( float* )malloc( (*n)*(size_t)LDC*sizeof( float ) );
+     C   = ( float* )malloc( (*n)*LDC*sizeof( float ) );
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -220,45 +312,49 @@ void F77_ssyr2k(int *order, char *uplow, char *transp, int *n, int *k,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_ssyr2k(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
   else
      cblas_ssyr2k(UNDEFINED, uplo, trans, *n, *k, *alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
 }
-void F77_strmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_strmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
               int *m, int *n, float *alpha, float *a, int *lda, float *b,
-              int *ldb) {
+              int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
+#endif
+) {
   int i,j,LDA,LDB;
   float *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A   = ( float* )malloc( (*m)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( float* )malloc( (*n)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDB = *n+1;
-     B   = ( float* )malloc( (*m)*(size_t)LDB*sizeof( float ) );
+     B   = ( float* )malloc( (*m)*LDB*sizeof( float ) );
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ )
            B[i*LDB+j]=b[j*(*ldb)+i];
@@ -270,7 +366,7 @@ void F77_strmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_strmm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
 		   a, *lda, b, *ldb);
   else
@@ -278,38 +374,42 @@ void F77_strmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
 		   a, *lda, b, *ldb);
 }
 
-void F77_strsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_strsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
               int *m, int *n, float *alpha, float *a, int *lda, float *b,
-              int *ldb) {
+              int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
+#endif
+) {
   int i,j,LDA,LDB;
   float *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A   = ( float* )malloc( (*m)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*m)*LDA*sizeof( float ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A   = ( float* )malloc( (*n)*(size_t)LDA*sizeof( float ) );
+        A   = ( float* )malloc( (*n)*LDA*sizeof( float ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDB = *n+1;
-     B   = ( float* )malloc( (*m)*(size_t)LDB*sizeof( float ) );
+     B   = ( float* )malloc( (*m)*LDB*sizeof( float ) );
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ )
            B[i*LDB+j]=b[j*(*ldb)+i];
@@ -321,7 +421,7 @@ void F77_strsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_strsm(CblasColMajor, side, uplo, trans, diag, *m, *n, *alpha,
 		   a, *lda, b, *ldb);
   else

ctest/c_sblat3.f

@@ -4,13 +4,13 @@
 *
 *  The program must be driven by a short data file. The first 13 records
 *  of the file are read using list-directed input, the last 6 records
-*  are read using the format ( A12, L2 ). An annotated example of a data
+*  are read using the format ( A13, L2 ). An annotated example of a data
 *  file can be obtained by deleting the first 3 characters from the
 *  following 19 lines:
 *  'SBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
 *  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
 *  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
-*  F        LOGICAL FLAG, T TO ERROR STOP ON FAILURES.
+*  F        LOGICAL FLAG, T TO STOP ON FAILURES.
 *  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
 *  2        0 TO TEST COLUMN-MAJOR, 1 TO TEST ROW-MAJOR, 2 TO TEST BOTH
 *  16.0     THRESHOLD VALUE OF TEST RATIO
@@ -20,12 +20,14 @@
 *  0.0 1.0 0.7       VALUES OF ALPHA
 *  3                 NUMBER OF VALUES OF BETA
 *  0.0 1.0 1.3       VALUES OF BETA
-*  cblas_sgemm  T PUT F FOR NO TEST. SAME COLUMNS.
-*  cblas_ssymm  T PUT F FOR NO TEST. SAME COLUMNS.
-*  cblas_strmm  T PUT F FOR NO TEST. SAME COLUMNS.
-*  cblas_strsm  T PUT F FOR NO TEST. SAME COLUMNS.
-*  cblas_ssyrk  T PUT F FOR NO TEST. SAME COLUMNS.
-*  cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS.
+*  cblas_sgemm   T PUT F FOR NO TEST. SAME COLUMNS.
+*  cblas_ssymm   T PUT F FOR NO TEST. SAME COLUMNS.
+*  cblas_strmm   T PUT F FOR NO TEST. SAME COLUMNS.
+*  cblas_strsm   T PUT F FOR NO TEST. SAME COLUMNS.
+*  cblas_ssyrk   T PUT F FOR NO TEST. SAME COLUMNS.
+*  cblas_ssyr2k  T PUT F FOR NO TEST. SAME COLUMNS.
+*  cblas_sgemmtr T PUT F FOR NO TEST. SAME COLUMNS.
+
 *
 *  See:
 *
@@ -46,7 +48,7 @@
       INTEGER            NIN, NOUT
       PARAMETER          ( NIN = 5, NOUT = 6 )
       INTEGER            NSUBS
-      PARAMETER          ( NSUBS = 6 )
+      PARAMETER          ( NSUBS = 7 )
       REAL               ZERO, HALF, ONE
       PARAMETER          ( ZERO = 0.0, HALF = 0.5, ONE = 1.0 )
       INTEGER            NMAX
@@ -60,7 +62,7 @@
       LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
      $                   TSTERR, CORDER, RORDER
       CHARACTER*1        TRANSA, TRANSB
-      CHARACTER*12       SNAMET
+      CHARACTER*13       SNAMET
       CHARACTER*32       SNAPS
 *     .. Local Arrays ..
       REAL               AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
@@ -71,27 +73,27 @@
      $                   G( NMAX ), W( 2*NMAX )
       INTEGER            IDIM( NIDMAX )
       LOGICAL            LTEST( NSUBS )
-      CHARACTER*12       SNAMES( NSUBS )
+      CHARACTER*13       SNAMES( NSUBS )
 *     .. External Functions ..
       REAL               SDIFF
       LOGICAL            LSE
       EXTERNAL           SDIFF, LSE
 *     .. External Subroutines ..
       EXTERNAL           SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, CS3CHKE,
-     $                   SMMCH
+     $                   SMMCH, SCHK6
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     .. Scalars in Common ..
       INTEGER            INFOT, NOUTC
       LOGICAL            OK
-      CHARACTER*12        SRNAMT
+      CHARACTER*13        SRNAMT
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK
       COMMON             /SRNAMC/SRNAMT
 *     .. Data statements ..
       DATA               SNAMES/'cblas_sgemm ', 'cblas_ssymm ',
      $                   'cblas_strmm ', 'cblas_strsm ','cblas_ssyrk ',
-     $                   'cblas_ssyr2k'/
+     $                   'cblas_ssyr2k', 'cblas_sgemmtr'/
 *     .. Executable Statements ..
 *
       NOUTC = NOUT
@@ -188,7 +190,7 @@
      $      GO TO 50
    40 CONTINUE
       WRITE( NOUT, FMT = 9990 )SNAMET
-      ERROR STOP
+      STOP
    50 LTEST( I ) = LTESTT
       GO TO 30
 *
@@ -231,7 +233,7 @@
       SAME = LSE( CC, CT, N )
       IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
-         ERROR STOP
+         STOP
       END IF
       TRANSB = 'T'
       CALL SMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
@@ -240,7 +242,7 @@
       SAME = LSE( CC, CT, N )
       IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
-         ERROR STOP
+         STOP
       END IF
       DO 120 J = 1, N
          AB( J, NMAX + 1 ) = N - J + 1
@@ -258,7 +260,7 @@
       SAME = LSE( CC, CT, N )
       IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
-         ERROR STOP
+         STOP
       END IF
       TRANSB = 'T'
       CALL SMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
@@ -267,7 +269,7 @@
       SAME = LSE( CC, CT, N )
       IF( .NOT.SAME.OR.ERR.NE.ZERO )THEN
          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
-         ERROR STOP
+         STOP
       END IF
 *
 *     Test each subroutine in turn.
@@ -288,7 +290,7 @@
             INFOT = 0
             OK = .TRUE.
             FATAL = .FALSE.
-            GO TO ( 140, 150, 160, 160, 170, 180 )ISNUM
+            GO TO ( 140, 150, 160, 160, 170, 180, 185 )ISNUM
 *           Test SGEMM, 01.
   140       IF (CORDER) THEN
             CALL SCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
@@ -359,8 +361,24 @@
      $                  1 )
             END IF
             GO TO 190
+*           Test SGEMMTR, 07.
+  185       IF (CORDER) THEN
+            CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
+     $          0 )
+
+            END IF
+            IF (RORDER) THEN
+            CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
+     $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
+     $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
+     $          1 )
+            END IF
+            GO TO 190
 *
-  190       IF( FATAL.AND.SFATAL )
+
+  190 IF( FATAL.AND.SFATAL )
      $         GO TO 210
          END IF
   200 CONTINUE
@@ -378,9 +396,7 @@
       IF( TRACE )
      $   CLOSE ( NTRA )
       CLOSE ( NOUT )
-      IF( FATAL ) THEN
-         ERROR STOP
-      END IF
+      STOP
 *
 10002 FORMAT( ' COLUMN-MAJOR AND ROW-MAJOR DATA LAYOUTS ARE TESTED' )
 10001 FORMAT( ' ROW-MAJOR DATA LAYOUT IS TESTED' )
@@ -398,7 +414,7 @@
  9992 FORMAT( '   FOR BETA           ', 7F6.1 )
  9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
      $      /' ******* TESTS ABANDONED *******' )
- 9990 FORMAT( ' SUBPROGRAM NAME ', A12,' NOT RECOGNIZED', /' ******* ',
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A13,' NOT RECOGNIZED', /' ******* ',
      $      'TESTS ABANDONED *******' )
  9989 FORMAT( ' ERROR IN SMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
      $      'ATED WRONGLY.', /' SMMCH WAS CALLED WITH TRANSA = ', A1,
@@ -406,8 +422,8 @@
      $      'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
      $      'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
      $      '*******' )
- 9988 FORMAT( A12,L2 )
- 9987 FORMAT( 1X, A12,' WAS NOT TESTED' )
+ 9988 FORMAT( A13,L2 )
+ 9987 FORMAT( 1X, A13,' WAS NOT TESTED' )
  9986 FORMAT( /' END OF TESTS' )
  9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
  9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
@@ -437,7 +453,7 @@
       REAL               EPS, THRESH
       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
       LOGICAL            FATAL, REWI, TRACE
-      CHARACTER*12        SNAME
+      CHARACTER*13        SNAME
 *     .. Array Arguments ..
       REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
@@ -683,22 +699,22 @@
   130 CONTINUE
       RETURN
 *
-10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
+10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
+10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
+10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
-10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
+10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
-C 9995 FORMAT( 1X, I6, ': ', A12,'(''', A1, ''',''', A1, ''',',
-C     $      3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
-C     $      'C,', I3, ').' )
+ 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A13,'(''', A1, ''',''', A1, ''',',
+     $      3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
+     $      'C,', I3, ').' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
      $      '******' )
 *
@@ -713,7 +729,7 @@ C     $      'C,', I3, ').' )
       INTEGER          NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC
       REAL             ALPHA, BETA
       CHARACTER*1      TRANSA, TRANSB
-      CHARACTER*12     SNAME
+      CHARACTER*13     SNAME
       CHARACTER*14     CRC, CTA,CTB
 
       IF (TRANSA.EQ.'N')THEN
@@ -738,7 +754,7 @@ C     $      'C,', I3, ').' )
       WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CTA,CTB
       WRITE(NOUT, FMT = 9994)M, N, K, ALPHA, LDA, LDB, BETA, LDC
 
- 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
  9994 FORMAT( 20X, 3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
      $ F4.1, ', ', 'C,', I3, ').' )
       END
@@ -765,7 +781,7 @@ C     $      'C,', I3, ').' )
       REAL               EPS, THRESH
       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
       LOGICAL            FATAL, REWI, TRACE
-      CHARACTER*12        SNAME
+      CHARACTER*13        SNAME
 *     .. Array Arguments ..
       REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
@@ -1000,22 +1016,22 @@ C     $      'C,', I3, ').' )
   120 CONTINUE
       RETURN
 *
-10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
+10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
+10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
+10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
-10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
+10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
-C 9995 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
-C     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
-C     $      ' .' )
+ 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
+     $      ' .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
      $      '******' )
 *
@@ -1028,7 +1044,7 @@ C     $      ' .' )
       INTEGER          NOUT, NC, IORDER, M, N, LDA, LDB, LDC
       REAL             ALPHA, BETA
       CHARACTER*1      SIDE, UPLO
-      CHARACTER*12     SNAME
+      CHARACTER*13     SNAME
       CHARACTER*14     CRC, CS,CU
 
       IF (SIDE.EQ.'L')THEN
@@ -1049,7 +1065,7 @@ C     $      ' .' )
       WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
       WRITE(NOUT, FMT = 9994)M, N, ALPHA, LDA, LDB, BETA, LDC
 
- 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
  9994 FORMAT( 20X, 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
      $ F4.1, ', ', 'C,', I3, ').' )
       END
@@ -1075,7 +1091,7 @@ C     $      ' .' )
       REAL               EPS, THRESH
       INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA, IORDER
       LOGICAL            FATAL, REWI, TRACE
-      CHARACTER*12        SNAME
+      CHARACTER*13        SNAME
 *     .. Array Arguments ..
       REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
@@ -1348,21 +1364,21 @@ C     $      ' .' )
   160 CONTINUE
       RETURN
 *
-10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
+10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
+10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
+10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
-10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
+10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
-C 9995 FORMAT( 1X, I6, ': ', A12,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
-C     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
+ 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
      $      '******' )
 *
@@ -1375,7 +1391,7 @@ C     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
       INTEGER          NOUT, NC, IORDER, M, N, LDA, LDB
       REAL             ALPHA
       CHARACTER*1      SIDE, UPLO, TRANSA, DIAG
-      CHARACTER*12     SNAME
+      CHARACTER*13     SNAME
       CHARACTER*14     CRC, CS, CU, CA, CD
 
       IF (SIDE.EQ.'L')THEN
@@ -1408,7 +1424,7 @@ C     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
       WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CS,CU
       WRITE(NOUT, FMT = 9994)CA, CD, M, N, ALPHA, LDA, LDB
 
- 9995 FORMAT( 1X, I6, ': ', A12,'(', A14, ',', A14, ',', A14, ',')
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',')
  9994 FORMAT( 22X, 2( A14, ',') , 2( I3, ',' ),
      $      F4.1, ', A,', I3, ', B,', I3, ').' )
       END
@@ -1435,7 +1451,7 @@ C     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
       REAL               EPS, THRESH
       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
       LOGICAL            FATAL, REWI, TRACE
-      CHARACTER*12        SNAME
+      CHARACTER*13        SNAME
 *     .. Array Arguments ..
       REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
@@ -1674,22 +1690,22 @@ C     $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
   130 CONTINUE
       RETURN
 *
-10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
+10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
+10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
+10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
-10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
+10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
-C 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
-C     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
+ 9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
  9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
      $      '******' )
 *
@@ -1702,7 +1718,7 @@ C     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
       INTEGER          NOUT, NC, IORDER, N, K, LDA, LDC
       REAL             ALPHA, BETA
       CHARACTER*1      UPLO, TRANSA
-      CHARACTER*12     SNAME
+      CHARACTER*13     SNAME
       CHARACTER*14     CRC, CU, CA
 
       IF (UPLO.EQ.'U')THEN
@@ -1725,7 +1741,7 @@ C     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
       WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
       WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, BETA, LDC
 
- 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
  9994 FORMAT( 20X, 2( I3, ',' ),
      $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ').' )
       END
@@ -1752,7 +1768,7 @@ C     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
       REAL               EPS, THRESH
       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
       LOGICAL            FATAL, REWI, TRACE
-      CHARACTER*12        SNAME
+      CHARACTER*13        SNAME
 *     .. Array Arguments ..
       REAL               AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
      $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
@@ -2029,23 +2045,23 @@ C     $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
   160 CONTINUE
       RETURN
 *
-10003 FORMAT( ' ', A12,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
+10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10002 FORMAT( ' ', A12,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
+10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
      $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
      $ 'RATIO ', F8.2, ' - SUSPECT *******' )
-10001 FORMAT( ' ', A12,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
+10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
-10000 FORMAT( ' ', A12,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
+10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
      $ ' (', I6, ' CALL', 'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9996 FORMAT( ' ******* ', A12,' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A13,' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
-C 9994 FORMAT( 1X, I6, ': ', A12,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
-C     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
-C     $      ' .' )
+ 9994 FORMAT( 1X, I6, ': ', A13,'(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+     $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
+     $      ' .' )
  9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
      $      '******' )
 *
@@ -2058,7 +2074,7 @@ C     $      ' .' )
       INTEGER          NOUT, NC, IORDER, N, K, LDA, LDB, LDC
       REAL             ALPHA, BETA
       CHARACTER*1      UPLO, TRANSA
-      CHARACTER*12     SNAME
+      CHARACTER*13     SNAME
       CHARACTER*14     CRC, CU, CA
 
       IF (UPLO.EQ.'U')THEN
@@ -2081,7 +2097,7 @@ C     $      ' .' )
       WRITE(NOUT, FMT = 9995)NC, SNAME, CRC, CU, CA
       WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
 
- 9995 FORMAT( 1X, I6, ': ', A12,'(', 3( A14, ',') )
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', 3( A14, ',') )
  9994 FORMAT( 20X, 2( I3, ',' ),
      $      F4.1, ', A,', I3, ', B', I3, ',', F4.1, ', C,', I3, ').' )
       END
@@ -2405,7 +2421,7 @@ C     $      ' .' )
    50    CONTINUE
       END IF
 *
-C   60 CONTINUE
+   60 CONTINUE
       LSERES = .TRUE.
       GO TO 80
    70 CONTINUE
@@ -2480,3 +2496,475 @@ C   60 CONTINUE
 *     End of SDIFF.
 *
       END
+
+
+      SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
+     $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
+     $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
+     $                  IORDER)
+*
+*  Tests SGEMMTR.
+*
+*  Auxiliary routine for test program for Level 3 Blas.
+*
+*  -- Written on 19-July-2023.
+*     Martin Koehler, MPI Magdeburg
+*
+*     .. Parameters ..
+      REAL   ZERO
+      PARAMETER          ( ZERO = 0.0 )
+*     .. Scalar Arguments ..
+      REAL               EPS, THRESH
+      INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
+      LOGICAL            FATAL, REWI, TRACE
+      CHARACTER*13       SNAME
+*     .. Array Arguments ..
+      REAL               A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
+     $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
+     $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
+     $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
+     $                   CS( NMAX*NMAX ), CT( NMAX ), G( NMAX )
+      INTEGER            IDIM( NIDIM )
+*     .. Local Scalars ..
+      REAL               ALPHA, ALS, BETA, BLS, ERR, ERRMAX
+      INTEGER            I, IA, IB, ICA, ICB, IK, IN, K, KS, LAA,
+     $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
+     $                   MA, MB, N, NA, NARGS, NB, NC, NS, IS
+      LOGICAL            NULL, RESET, SAME, TRANA, TRANB
+      CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
+      CHARACTER*3        ICH
+      CHARACTER*2        ISHAPE
+*     .. Local Arrays ..
+      LOGICAL            ISAME( 13 )
+*     .. External Functions ..
+      LOGICAL            LSE, LSERES
+      EXTERNAL           LSE, LSERES
+*     .. External Subroutines ..
+      EXTERNAL           CSGEMMTR, SMAKE, SMMTCH, SPRCN8
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     .. Scalars in Common ..
+      INTEGER            INFOT, NOUTC
+      LOGICAL            LERR, OK
+*     .. Common blocks ..
+      COMMON             /INFOC/INFOT, NOUTC, OK, LERR
+*     .. Data statements ..
+      DATA               ICH/'NTC'/
+      DATA               ISHAPE/'UL'/
+*     .. Executable Statements ..
+*
+      NARGS = 13
+      NC = 0
+      RESET = .TRUE.
+      ERRMAX = ZERO
+*
+      DO 100 IN = 1, NIDIM
+         N = IDIM( IN )
+*        Set LDC to 1 more than minimum value if room.
+         LDC = N
+         IF( LDC.LT.NMAX )
+     $      LDC = LDC + 1
+*        Skip tests if not enough room.
+         IF( LDC.GT.NMAX )
+     $      GO TO 100
+         LCC = LDC*N
+         NULL = N.LE.0
+*
+         DO 90 IK = 1, NIDIM
+            K = IDIM( IK )
+*
+            DO 80 ICA = 1, 3
+               TRANSA = ICH( ICA: ICA )
+               TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+*
+               IF( TRANA )THEN
+                  MA = K
+                  NA = N
+               ELSE
+                  MA = N
+                  NA = K
+               END IF
+*              Set LDA to 1 more than minimum value if room.
+               LDA = MA
+               IF( LDA.LT.NMAX )
+     $            LDA = LDA + 1
+*              Skip tests if not enough room.
+               IF( LDA.GT.NMAX )
+     $            GO TO 80
+               LAA = LDA*NA
+*
+*              Generate the matrix A.
+*
+               CALL SMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
+     $                     RESET, ZERO )
+*
+               DO 70 ICB = 1, 3
+                  TRANSB = ICH( ICB: ICB )
+                  TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+                  IF( TRANB )THEN
+                     MB = N
+                     NB = K
+                  ELSE
+                     MB = K
+                     NB = N
+                  END IF
+*                 Set LDB to 1 more than minimum value if room.
+                  LDB = MB
+                  IF( LDB.LT.NMAX )
+     $               LDB = LDB + 1
+*                 Skip tests if not enough room.
+                  IF( LDB.GT.NMAX )
+     $               GO TO 70
+                  LBB = LDB*NB
+*
+*                 Generate the matrix B.
+*
+                  CALL SMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
+     $                        LDB, RESET, ZERO )
+*
+                  DO 60 IA = 1, NALF
+                     ALPHA = ALF( IA )
+*
+                     DO 50 IB = 1, NBET
+                        BETA = BET( IB )
+
+                        DO 45 IS = 1, 2
+                           UPLO = ISHAPE( IS: IS )
+
+*
+*                          Generate the matrix C.
+*
+                           CALL SMAKE( 'GE', UPLO, ' ', N, N, C,
+     $                                 NMAX, CC, LDC, RESET, ZERO )
+*
+                           NC = NC + 1
+*
+*                          Save every datum before calling the
+*                          subroutine.
+*
+                           UPLOS = UPLO
+                           TRANAS = TRANSA
+                           TRANBS = TRANSB
+                           NS = N
+                           KS = K
+                           ALS = ALPHA
+                           DO 10 I = 1, LAA
+                              AS( I ) = AA( I )
+   10                      CONTINUE
+                           LDAS = LDA
+                           DO 20 I = 1, LBB
+                              BS( I ) = BB( I )
+   20                      CONTINUE
+                           LDBS = LDB
+                           BLS = BETA
+                           DO 30 I = 1, LCC
+                              CS( I ) = CC( I )
+   30                      CONTINUE
+                           LDCS = LDC
+*
+*                          Call the subroutine.
+*
+                           IF( TRACE )
+     $                        CALL SPRCN8(NTRA, NC, SNAME, IORDER, UPLO,
+     $                        TRANSA, TRANSB, N, K, ALPHA, LDA,
+     $                        LDB, BETA, LDC)
+                           IF( REWI )
+     $                        REWIND NTRA
+                           CALL CSGEMMTR( IORDER, UPLO, TRANSA, TRANSB,
+     $                                  N, K, ALPHA, AA, LDA, BB, LDB,
+     $                                  BETA, CC, LDC )
+*
+*                          Check if error-exit was taken incorrectly.
+*
+                           IF( .NOT.OK )THEN
+                              WRITE( NOUT, FMT = 9994 )
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+*                          See what data changed inside subroutines.
+*
+                           ISAME( 1 ) = UPLO.EQ.UPLOS
+                           ISAME( 2 ) = TRANSA.EQ.TRANAS
+                           ISAME( 3 ) = TRANSB.EQ.TRANBS
+                           ISAME( 4 ) = NS.EQ.N
+                           ISAME( 5 ) = KS.EQ.K
+                           ISAME( 6 ) = ALS.EQ.ALPHA
+                           ISAME( 7 ) = LSE( AS, AA, LAA )
+                           ISAME( 8 ) = LDAS.EQ.LDA
+                           ISAME( 9 ) = LSE( BS, BB, LBB )
+                           ISAME( 10 ) = LDBS.EQ.LDB
+                           ISAME( 11 ) = BLS.EQ.BETA
+                           IF( NULL )THEN
+                              ISAME( 12 ) = LSE( CS, CC, LCC )
+                           ELSE
+                              ISAME( 12 ) = LSERES( 'GE', ' ', N, N,
+     $                                          CS, CC, LDC )
+                           END IF
+                           ISAME( 13 ) = LDCS.EQ.LDC
+*
+*                          If data was incorrectly changed, report
+*                          and return.
+*
+                           SAME = .TRUE.
+                           DO 40 I = 1, NARGS
+                              SAME = SAME.AND.ISAME( I )
+                              IF( .NOT.ISAME( I ) )
+     $                           WRITE( NOUT, FMT = 9998 )I
+   40                      CONTINUE
+                           IF( .NOT.SAME )THEN
+                              FATAL = .TRUE.
+                              GO TO 120
+                           END IF
+*
+                           IF( .NOT.NULL )THEN
+*
+*                             Check the result.
+*
+                              CALL SMMTCH( UPLO, TRANSA, TRANSB,
+     $                                 N, K,
+     $                                 ALPHA, A, NMAX, B, NMAX, BETA,
+     $                                 C, NMAX, CT, G, CC, LDC, EPS,
+     $                                 ERR, FATAL, NOUT, .TRUE. )
+                              ERRMAX = MAX( ERRMAX, ERR )
+*                             If got really bad answer, report and
+*                             return.
+                              IF( FATAL )
+     $                           GO TO 120
+                           END IF
+*
+   45                   CONTINUE
+*
+   50                CONTINUE
+*
+   60             CONTINUE
+*
+   70          CONTINUE
+*
+   80       CONTINUE
+*
+   90    CONTINUE
+*
+  100 CONTINUE
+*
+*
+*     Report result.
+*
+      IF( ERRMAX.LT.THRESH )THEN
+         IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10000 )SNAME, NC
+         IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10001 )SNAME, NC
+      ELSE
+         IF ( IORDER.EQ.0) WRITE( NOUT, FMT = 10002 )SNAME, NC, ERRMAX
+         IF ( IORDER.EQ.1) WRITE( NOUT, FMT = 10003 )SNAME, NC, ERRMAX
+      END IF
+      GO TO 130
+*
+  120 CONTINUE
+      WRITE( NOUT, FMT = 9996 )SNAME
+      CALL SPRCN8(NOUT, NC, SNAME, IORDER, UPLO, TRANSA, TRANSB,
+     $           N, K, ALPHA, LDA, LDB, BETA, LDC)
+*
+  130 CONTINUE
+      RETURN
+*
+10003 FORMAT( ' ', A13,' COMPLETED THE ROW-MAJOR    COMPUTATIONAL ',
+     $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
+     $ 'RATIO ', F8.2, ' - SUSPECT *******' )
+10002 FORMAT( ' ', A13,' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
+     $ 'TESTS (', I6, ' CALLS)', /' ******* BUT WITH MAXIMUM TEST ',
+     $ 'RATIO ', F8.2, ' - SUSPECT *******' )
+10001 FORMAT( ' ', A13,' PASSED THE ROW-MAJOR    COMPUTATIONAL TESTS',
+     $ ' (', I6, ' CALL', 'S)' )
+10000 FORMAT( ' ', A13,' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
+     $ ' (', I6, ' CALL', 'S)' )
+ 9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
+     $      'ANGED INCORRECTLY *******' )
+ 9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+     $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
+     $      ' - SUSPECT *******' )
+ 9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',',
+     $      2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
+     $      'C,', I3, ').' )
+ 9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
+     $      '******' )
+*
+*     End of SCHK6
+*
+      END
+
+      SUBROUTINE SPRCN8(NOUT, NC, SNAME, IORDER, UPLO,
+     $                 TRANSA, TRANSB, N,
+     $                 K, ALPHA, LDA, LDB, BETA, LDC)
+      INTEGER          NOUT, NC, IORDER, N, K, LDA, LDB, LDC
+      REAL             ALPHA, BETA
+      CHARACTER*1      TRANSA, TRANSB, UPLO
+      CHARACTER*13     SNAME
+      CHARACTER*14     CRC, CTA,CTB,CUPLO
+
+      IF (UPLO.EQ.'U') THEN
+          CUPLO = 'CblasUpper'
+      ELSE
+          CUPLO = 'CblasLower'
+      END IF
+      IF (TRANSA.EQ.'N')THEN
+         CTA = '  CblasNoTrans'
+      ELSE IF (TRANSA.EQ.'T')THEN
+         CTA = '    CblasTrans'
+      ELSE
+         CTA = 'CblasConjTrans'
+      END IF
+      IF (TRANSB.EQ.'N')THEN
+         CTB = '  CblasNoTrans'
+      ELSE IF (TRANSB.EQ.'T')THEN
+         CTB = '    CblasTrans'
+      ELSE
+         CTB = 'CblasConjTrans'
+      END IF
+      IF (IORDER.EQ.1)THEN
+         CRC = ' CblasRowMajor'
+      ELSE
+         CRC = ' CblasColMajor'
+      END IF
+      WRITE(NOUT, FMT = 9995)NC,SNAME,CRC, CUPLO, CTA,CTB
+      WRITE(NOUT, FMT = 9994)N, K, ALPHA, LDA, LDB, BETA, LDC
+
+ 9995 FORMAT( 1X, I6, ': ', A13,'(', A14, ',', A14, ',', A14, ',',
+     $        A14, ',')
+ 9994 FORMAT( 10X, 2( I3, ',' ) ,' ', F4.1,' , A,',
+     $ I3, ', B,', I3, ', ', F4.1,' , C,', I3, ').' )
+      END
+
+      SUBROUTINE SMMTCH( UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
+     $                  B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR,
+     $                  FATAL, NOUT, MV )
+*
+*  Checks the results of the computational tests.
+*
+*  Auxiliary routine for test program for Level 3 Blas. (DGEMMTR)
+*
+*  -- Written on 19-July-2023.
+*     Martin Koehler, MPI Magdeburg
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0, ONE = 1.0 )
+*     .. Scalar Arguments ..
+      REAL   ALPHA, BETA, EPS, ERR
+      INTEGER            KK, LDA, LDB, LDC, LDCC, N, NOUT
+      LOGICAL            FATAL, MV
+      CHARACTER*1        UPLO, TRANSA, TRANSB
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), B( LDB, * ), C( LDC, * ),
+     $                   CC( LDCC, * ), CT( * ), G( * )
+*     .. Local Scalars ..
+      REAL   ERRI
+      INTEGER            I, J, K, ISTART, ISTOP
+      LOGICAL            TRANA, TRANB, UPPER
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SQRT
+*     .. Executable Statements ..
+      UPPER = UPLO.EQ.'U'
+      TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
+      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
+*
+*     Compute expected result, one column at a time, in CT using data
+*     in A, B and C.
+*     Compute gauges in G.
+*
+      ISTART = 1
+      ISTOP  = N
+
+      DO 120 J = 1, N
+*
+         IF ( UPPER ) THEN
+             ISTART = 1
+             ISTOP = J
+         ELSE
+             ISTART = J
+             ISTOP = N
+         END IF
+         DO 10 I = ISTART, ISTOP
+            CT( I ) = ZERO
+            G( I ) = ZERO
+   10    CONTINUE
+         IF( .NOT.TRANA.AND..NOT.TRANB )THEN
+            DO 30 K = 1, KK
+               DO 20 I = ISTART, ISTOP
+                  CT( I ) = CT( I ) + A( I, K )*B( K, J )
+                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( K, J ) )
+   20          CONTINUE
+   30       CONTINUE
+         ELSE IF( TRANA.AND..NOT.TRANB )THEN
+            DO 50 K = 1, KK
+               DO 40 I = ISTART, ISTOP
+                  CT( I ) = CT( I ) + A( K, I )*B( K, J )
+                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( K, J ) )
+   40          CONTINUE
+   50       CONTINUE
+         ELSE IF( .NOT.TRANA.AND.TRANB )THEN
+            DO 70 K = 1, KK
+               DO 60 I = ISTART, ISTOP
+                  CT( I ) = CT( I ) + A( I, K )*B( J, K )
+                  G( I ) = G( I ) + ABS( A( I, K ) )*ABS( B( J, K ) )
+   60          CONTINUE
+   70       CONTINUE
+         ELSE IF( TRANA.AND.TRANB )THEN
+            DO 90 K = 1, KK
+               DO 80 I = ISTART, ISTOP
+                  CT( I ) = CT( I ) + A( K, I )*B( J, K )
+                  G( I ) = G( I ) + ABS( A( K, I ) )*ABS( B( J, K ) )
+   80          CONTINUE
+   90       CONTINUE
+         END IF
+         DO 100 I = ISTART, ISTOP
+            CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
+            G( I ) = ABS( ALPHA )*G( I ) + ABS( BETA )*ABS( C( I, J ) )
+  100    CONTINUE
+*
+*        Compute the error ratio for this result.
+*
+         ERR = ZERO
+         DO 110 I = ISTART, ISTOP
+            ERRI = ABS( CT( I ) - CC( I, J ) )/EPS
+            IF( G( I ).NE.ZERO )
+     $         ERRI = ERRI/G( I )
+            ERR = MAX( ERR, ERRI )
+            IF( ERR*SQRT( EPS ).GE.ONE )
+     $         GO TO 130
+  110    CONTINUE
+*
+  120 CONTINUE
+*
+*     If the loop completes, all results are at least half accurate.
+      GO TO 150
+*
+*     Report fatal error.
+*
+  130 FATAL = .TRUE.
+      WRITE( NOUT, FMT = 9999 )
+      DO 140 I = ISTART, ISTOP
+         IF( MV )THEN
+            WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
+         ELSE
+            WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
+         END IF
+  140 CONTINUE
+      IF( N.GT.1 )
+     $   WRITE( NOUT, FMT = 9997 )J
+*
+  150 CONTINUE
+      RETURN
+*
+ 9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
+     $      'F ACCURATE *******', /'           EXPECTED RESULT   COMPU',
+     $      'TED RESULT' )
+ 9998 FORMAT( 1X, I7, 2G18.6 )
+ 9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
+*
+*     End of SMMTCH
+*
+      END
+
+

ctest/c_zblas3.c

@@ -5,28 +5,33 @@
  *     Modified by T. H. Do, 4/15/98, SGI/CRAY Research.
  */
 #include <stdlib.h>
-#include "common.h"
+#include <stdio.h>
+#include "cblas.h"
 #include "cblas_test.h"
 #define  TEST_COL_MJR	0
 #define  TEST_ROW_MJR	1
 #define  UNDEFINED     -1
 
-void F77_zgemm(int *order, char *transpa, char *transpb, int *m, int *n,
+void F77_zgemm(int *layout, char *transpa, char *transpb, int *m, int *n,
      int *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
      CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta,
-     CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+     CBLAS_TEST_ZOMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN transpa_len, FORTRAN_STRLEN transpb_len
+#endif
+) {
 
   CBLAS_TEST_ZOMPLEX *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_TRANSPOSE transa, transb;
+  CBLAS_TRANSPOSE transa, transb;
 
   get_transpose_type(transpa, &transa);
   get_transpose_type(transpb, &transb);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (transa == CblasNoTrans) {
         LDA = *k+1;
-        A=(CBLAS_TEST_ZOMPLEX*)malloc((*m)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*m; i++ )
            for( j=0; j<*k; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -35,7 +40,7 @@ void F77_zgemm(int *order, char *transpa, char *transpb, int *m, int *n,
      }
      else {
         LDA = *m+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((size_t)LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*k; i++ )
            for( j=0; j<*m; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -45,7 +50,7 @@ void F77_zgemm(int *order, char *transpa, char *transpb, int *m, int *n,
 
      if (transb == CblasNoTrans) {
         LDB = *n+1;
-        B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*(size_t)LDB*sizeof(CBLAS_TEST_ZOMPLEX) );
+        B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_ZOMPLEX) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ ) {
               B[i*LDB+j].real=b[j*(*ldb)+i].real;
@@ -54,7 +59,7 @@ void F77_zgemm(int *order, char *transpa, char *transpb, int *m, int *n,
      }
      else {
         LDB = *k+1;
-        B=(CBLAS_TEST_ZOMPLEX* )malloc((size_t)LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX));
+        B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ ) {
               B[i*LDB+j].real=b[j*(*ldb)+i].real;
@@ -63,7 +68,7 @@ void F77_zgemm(int *order, char *transpa, char *transpb, int *m, int *n,
      }
 
      LDC = *n+1;
-     C=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDC*sizeof(CBLAS_TEST_ZOMPLEX));
+     C=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_ZOMPLEX));
      for( j=0; j<*n; j++ )
         for( i=0; i<*m; i++ ) {
            C[i*LDC+j].real=c[j*(*ldc)+i].real;
@@ -80,30 +85,116 @@ void F77_zgemm(int *order, char *transpa, char *transpb, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_zgemm( CblasColMajor, transa, transb, *m, *n, *k, alpha, a, *lda,
                   b, *ldb, beta, c, *ldc );
   else
      cblas_zgemm( UNDEFINED, transa, transb, *m, *n, *k, alpha, a, *lda,
                   b, *ldb, beta, c, *ldc );
 }
-void F77_zhemm(int *order, char *rtlf, char *uplow, int *m, int *n,
+
+
+void F77_zgemmtr(int *layout, char *uplop, char *transpa, char *transpb, int *n,
+     int *k, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
+     CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta,
+     CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+
+  CBLAS_TEST_ZOMPLEX *A, *B, *C;
+  int i,j,LDA, LDB, LDC;
+  CBLAS_TRANSPOSE transa, transb;
+  CBLAS_UPLO uplo;
+
+  get_transpose_type(transpa, &transa);
+  get_transpose_type(transpb, &transb);
+  get_uplo_type(uplop, &uplo);
+
+  if (*layout == TEST_ROW_MJR) {
+      if (transa == CblasNoTrans) {
+          LDA = *k+1;
+          A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+          for( i=0; i<*n; i++ )
+              for( j=0; j<*k; j++ ) {
+                  A[i*LDA+j].real=a[j*(*lda)+i].real;
+                  A[i*LDA+j].imag=a[j*(*lda)+i].imag;
+              }
+      }
+      else {
+          LDA = *n+1;
+          A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
+          for( i=0; i<*k; i++ )
+              for( j=0; j<*n; j++ ) {
+                  A[i*LDA+j].real=a[j*(*lda)+i].real;
+                  A[i*LDA+j].imag=a[j*(*lda)+i].imag;
+              }
+      }
+
+      if (transb == CblasNoTrans) {
+          LDB = *n+1;
+          B=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDB*sizeof(CBLAS_TEST_ZOMPLEX) );
+          for( i=0; i<*k; i++ )
+              for( j=0; j<*n; j++ ) {
+                  B[i*LDB+j].real=b[j*(*ldb)+i].real;
+                  B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
+              }
+      }
+      else {
+          LDB = *k+1;
+          B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*n)*sizeof(CBLAS_TEST_ZOMPLEX));
+          for( i=0; i<*n; i++ )
+              for( j=0; j<*k; j++ ) {
+                  B[i*LDB+j].real=b[j*(*ldb)+i].real;
+                  B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
+              }
+      }
+
+      LDC = *n+1;
+      C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX));
+      for( j=0; j<*n; j++ )
+          for( i=0; i<*n; i++ ) {
+              C[i*LDC+j].real=c[j*(*ldc)+i].real;
+              C[i*LDC+j].imag=c[j*(*ldc)+i].imag;
+          }
+      cblas_zgemmtr( CblasRowMajor, uplo, transa, transb, *n, *k, alpha, A, LDA,
+              B, LDB, beta, C, LDC );
+      for( j=0; j<*n; j++ )
+          for( i=0; i<*n; i++ ) {
+              c[j*(*ldc)+i].real=C[i*LDC+j].real;
+              c[j*(*ldc)+i].imag=C[i*LDC+j].imag;
+          }
+      free(A);
+      free(B);
+      free(C);
+  }
+  else if (*layout == TEST_COL_MJR)
+      cblas_zgemmtr( CblasColMajor, uplo, transa, transb, *n, *k, alpha, a, *lda,
+              b, *ldb, beta, c, *ldc );
+  else
+      cblas_zgemmtr( UNDEFINED, uplo, transa, transb, *n, *k, alpha, a, *lda,
+              b, *ldb, beta, c, *ldc );
+}
+
+
+void F77_zhemm(int *layout, char *rtlf, char *uplow, int *m, int *n,
         CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
 	CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta,
-        CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+        CBLAS_TEST_ZOMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
+#endif
+) {
 
   CBLAS_TEST_ZOMPLEX *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_SIDE side;
+  CBLAS_UPLO uplo;
+  CBLAS_SIDE side;
 
   get_uplo_type(uplow,&uplo);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A= (CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        A= (CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -112,7 +203,7 @@ void F77_zhemm(int *order, char *rtlf, char *uplow, int *m, int *n,
      }
      else{
         LDA = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -120,14 +211,14 @@ void F77_zhemm(int *order, char *rtlf, char *uplow, int *m, int *n,
            }
      }
      LDB = *n+1;
-     B=(CBLAS_TEST_ZOMPLEX* )malloc( (*m)*(size_t)LDB*sizeof(CBLAS_TEST_ZOMPLEX ) );
+     B=(CBLAS_TEST_ZOMPLEX* )malloc( (*m)*LDB*sizeof(CBLAS_TEST_ZOMPLEX ) );
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ ) {
            B[i*LDB+j].real=b[j*(*ldb)+i].real;
            B[i*LDB+j].imag=b[j*(*ldb)+i].imag;
         }
      LDC = *n+1;
-     C=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
+     C=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
      for( j=0; j<*n; j++ )
         for( i=0; i<*m; i++ ) {
            C[i*LDC+j].real=c[j*(*ldc)+i].real;
@@ -144,48 +235,52 @@ void F77_zhemm(int *order, char *rtlf, char *uplow, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_zhemm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
                   beta, c, *ldc );
   else
      cblas_zhemm( UNDEFINED, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
                   beta, c, *ldc );
 }
-void F77_zsymm(int *order, char *rtlf, char *uplow, int *m, int *n,
+void F77_zsymm(int *layout, char *rtlf, char *uplow, int *m, int *n,
           CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
 	  CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta,
-          CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+          CBLAS_TEST_ZOMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len
+#endif
+) {
 
   CBLAS_TEST_ZOMPLEX *A, *B, *C;
   int i,j,LDA, LDB, LDC;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_SIDE side;
+  CBLAS_UPLO uplo;
+  CBLAS_SIDE side;
 
   get_uplo_type(uplow,&uplo);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      else{
         LDA = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ )
               A[i*LDA+j]=a[j*(*lda)+i];
      }
      LDB = *n+1;
-     B=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDB*sizeof(CBLAS_TEST_ZOMPLEX ));
+     B=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_ZOMPLEX ));
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ )
            B[i*LDB+j]=b[j*(*ldb)+i];
      LDC = *n+1;
-     C=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDC*sizeof(CBLAS_TEST_ZOMPLEX));
+     C=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDC*sizeof(CBLAS_TEST_ZOMPLEX));
      for( j=0; j<*n; j++ )
         for( i=0; i<*m; i++ )
            C[i*LDC+j]=c[j*(*ldc)+i];
@@ -198,7 +293,7 @@ void F77_zsymm(int *order, char *rtlf, char *uplow, int *m, int *n,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_zsymm( CblasColMajor, side, uplo, *m, *n, alpha, a, *lda, b, *ldb,
                   beta, c, *ldc );
   else
@@ -206,22 +301,26 @@ void F77_zsymm(int *order, char *rtlf, char *uplow, int *m, int *n,
                   beta, c, *ldc );
 }
 
-void F77_zherk(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_zherk(int *layout, char *uplow, char *transp, int *n, int *k,
      double *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
-     double *beta, CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+     double *beta, CBLAS_TEST_ZOMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
 
   int i,j,LDA,LDC;
   CBLAS_TEST_ZOMPLEX *A, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -230,7 +329,7 @@ void F77_zherk(int *order, char *uplow, char *transp, int *n, int *k,
      }
      else{
         LDA = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -238,7 +337,7 @@ void F77_zherk(int *order, char *uplow, char *transp, int *n, int *k,
            }
      }
      LDC = *n+1;
-     C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
+     C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ ) {
            C[i*LDC+j].real=c[j*(*ldc)+i].real;
@@ -254,7 +353,7 @@ void F77_zherk(int *order, char *uplow, char *transp, int *n, int *k,
      free(A);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_zherk(CblasColMajor, uplo, trans, *n, *k, *alpha, a, *lda, *beta,
 	         c, *ldc );
   else
@@ -262,22 +361,26 @@ void F77_zherk(int *order, char *uplow, char *transp, int *n, int *k,
 	         c, *ldc );
 }
 
-void F77_zsyrk(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_zsyrk(int *layout, char *uplow, char *transp, int *n, int *k,
      CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
-     CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+     CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
 
   int i,j,LDA,LDC;
   CBLAS_TEST_ZOMPLEX *A, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -286,7 +389,7 @@ void F77_zsyrk(int *order, char *uplow, char *transp, int *n, int *k,
      }
      else{
         LDA = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -294,7 +397,7 @@ void F77_zsyrk(int *order, char *uplow, char *transp, int *n, int *k,
            }
      }
      LDC = *n+1;
-     C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
+     C=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ ) {
            C[i*LDC+j].real=c[j*(*ldc)+i].real;
@@ -310,31 +413,35 @@ void F77_zsyrk(int *order, char *uplow, char *transp, int *n, int *k,
      free(A);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_zsyrk(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda, beta,
 	         c, *ldc );
   else
      cblas_zsyrk(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda, beta,
 	         c, *ldc );
 }
-void F77_zher2k(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_zher2k(int *layout, char *uplow, char *transp, int *n, int *k,
         CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
 	CBLAS_TEST_ZOMPLEX *b, int *ldb, double *beta,
-        CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+        CBLAS_TEST_ZOMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
   int i,j,LDA,LDB,LDC;
   CBLAS_TEST_ZOMPLEX *A, *B, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         LDB = *k+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
-        B=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDB*sizeof(CBLAS_TEST_ZOMPLEX ));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
+        B=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_ZOMPLEX ));
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -346,8 +453,8 @@ void F77_zher2k(int *order, char *uplow, char *transp, int *n, int *k,
      else {
         LDA = *n+1;
         LDB = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc( (size_t)LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX ) );
-        B=(CBLAS_TEST_ZOMPLEX* )malloc( (size_t)LDB*(*k)*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        A=(CBLAS_TEST_ZOMPLEX* )malloc( LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        B=(CBLAS_TEST_ZOMPLEX* )malloc( LDB*(*k)*sizeof(CBLAS_TEST_ZOMPLEX ) );
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ ){
 	      A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -357,7 +464,7 @@ void F77_zher2k(int *order, char *uplow, char *transp, int *n, int *k,
            }
      }
      LDC = *n+1;
-     C=(CBLAS_TEST_ZOMPLEX* )malloc( (*n)*(size_t)LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
+     C=(CBLAS_TEST_ZOMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX ) );
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ ) {
            C[i*LDC+j].real=c[j*(*ldc)+i].real;
@@ -374,31 +481,35 @@ void F77_zher2k(int *order, char *uplow, char *transp, int *n, int *k,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_zher2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
   else
      cblas_zher2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, *beta, c, *ldc );
 }
-void F77_zsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
+void F77_zsyr2k(int *layout, char *uplow, char *transp, int *n, int *k,
          CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda,
 	 CBLAS_TEST_ZOMPLEX *b, int *ldb, CBLAS_TEST_ZOMPLEX *beta,
-         CBLAS_TEST_ZOMPLEX *c, int *ldc ) {
+         CBLAS_TEST_ZOMPLEX *c, int *ldc
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len
+#endif
+) {
   int i,j,LDA,LDB,LDC;
   CBLAS_TEST_ZOMPLEX *A, *B, *C;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (trans == CblasNoTrans) {
         LDA = *k+1;
         LDB = *k+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
-        B=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDB*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        B=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDB*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*n; i++ )
            for( j=0; j<*k; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -410,8 +521,8 @@ void F77_zsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
      else {
         LDA = *n+1;
         LDB = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((size_t)LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
-        B=(CBLAS_TEST_ZOMPLEX* )malloc((size_t)LDB*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc(LDA*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
+        B=(CBLAS_TEST_ZOMPLEX* )malloc(LDB*(*k)*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*k; i++ )
            for( j=0; j<*n; j++ ){
 	      A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -421,7 +532,7 @@ void F77_zsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
            }
      }
      LDC = *n+1;
-     C=(CBLAS_TEST_ZOMPLEX* )malloc( (*n)*(size_t)LDC*sizeof(CBLAS_TEST_ZOMPLEX));
+     C=(CBLAS_TEST_ZOMPLEX* )malloc( (*n)*LDC*sizeof(CBLAS_TEST_ZOMPLEX));
      for( i=0; i<*n; i++ )
         for( j=0; j<*n; j++ ) {
            C[i*LDC+j].real=c[j*(*ldc)+i].real;
@@ -438,32 +549,36 @@ void F77_zsyr2k(int *order, char *uplow, char *transp, int *n, int *k,
      free(B);
      free(C);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_zsyr2k(CblasColMajor, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, beta, c, *ldc );
   else
      cblas_zsyr2k(UNDEFINED, uplo, trans, *n, *k, alpha, a, *lda,
 		   b, *ldb, beta, c, *ldc );
 }
-void F77_ztrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_ztrmm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
        int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a,
-       int *lda, CBLAS_TEST_ZOMPLEX *b, int *ldb) {
+       int *lda, CBLAS_TEST_ZOMPLEX *b, int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
+#endif
+) {
   int i,j,LDA,LDB;
   CBLAS_TEST_ZOMPLEX *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -472,7 +587,7 @@ void F77_ztrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      }
      else{
         LDA = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -480,7 +595,7 @@ void F77_ztrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
            }
      }
      LDB = *n+1;
-     B=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDB*sizeof(CBLAS_TEST_ZOMPLEX));
+     B=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_ZOMPLEX));
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ ) {
            B[i*LDB+j].real=b[j*(*ldb)+i].real;
@@ -496,7 +611,7 @@ void F77_ztrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_ztrmm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
 		   a, *lda, b, *ldb);
   else
@@ -504,25 +619,29 @@ void F77_ztrmm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
 		   a, *lda, b, *ldb);
 }
 
-void F77_ztrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
+void F77_ztrsm(int *layout, char *rtlf, char *uplow, char *transp, char *diagn,
          int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a,
-         int *lda, CBLAS_TEST_ZOMPLEX *b, int *ldb) {
+         int *lda, CBLAS_TEST_ZOMPLEX *b, int *ldb
+#ifdef BLAS_FORTRAN_STRLEN_END
+  , FORTRAN_STRLEN rtlf_len, FORTRAN_STRLEN uplow_len, FORTRAN_STRLEN transp_len, FORTRAN_STRLEN diagn_len
+#endif
+) {
   int i,j,LDA,LDB;
   CBLAS_TEST_ZOMPLEX *A, *B;
-  enum CBLAS_SIDE side;
-  enum CBLAS_DIAG diag;
-  enum CBLAS_UPLO uplo;
-  enum CBLAS_TRANSPOSE trans;
+  CBLAS_SIDE side;
+  CBLAS_DIAG diag;
+  CBLAS_UPLO uplo;
+  CBLAS_TRANSPOSE trans;
 
   get_uplo_type(uplow,&uplo);
   get_transpose_type(transp,&trans);
   get_diag_type(diagn,&diag);
   get_side_type(rtlf,&side);
 
-  if (*order == TEST_ROW_MJR) {
+  if (*layout == TEST_ROW_MJR) {
      if (side == CblasLeft) {
         LDA = *m+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc( (*m)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
+        A=(CBLAS_TEST_ZOMPLEX* )malloc( (*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
         for( i=0; i<*m; i++ )
            for( j=0; j<*m; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -531,7 +650,7 @@ void F77_ztrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      }
      else{
         LDA = *n+1;
-        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*(size_t)LDA*sizeof(CBLAS_TEST_ZOMPLEX));
+        A=(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
         for( i=0; i<*n; i++ )
            for( j=0; j<*n; j++ ) {
               A[i*LDA+j].real=a[j*(*lda)+i].real;
@@ -539,7 +658,7 @@ void F77_ztrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
            }
      }
      LDB = *n+1;
-     B=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*(size_t)LDB*sizeof(CBLAS_TEST_ZOMPLEX));
+     B=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDB*sizeof(CBLAS_TEST_ZOMPLEX));
      for( i=0; i<*m; i++ )
         for( j=0; j<*n; j++ ) {
            B[i*LDB+j].real=b[j*(*ldb)+i].real;
@@ -555,12 +674,10 @@ void F77_ztrsm(int *order, char *rtlf, char *uplow, char *transp, char *diagn,
      free(A);
      free(B);
   }
-  else if (*order == TEST_COL_MJR)
+  else if (*layout == TEST_COL_MJR)
      cblas_ztrsm(CblasColMajor, side, uplo, trans, diag, *m, *n, alpha,
 		   a, *lda, b, *ldb);
   else
      cblas_ztrsm(UNDEFINED, side, uplo, trans, diag, *m, *n, alpha,
 		   a, *lda, b, *ldb);
 }
-
-

ctest/cblas_test.h

@@ -5,18 +5,15 @@
 #ifndef CBLAS_TEST_H
 #define CBLAS_TEST_H
 #include "cblas.h"
+#include "cblas_mangling.h"
 
-#ifdef USE64BITINT
-#define int long
-#endif
+/* It seems all current Fortran compilers put strlen at end.
+*  Some historical compilers put strlen after the str argument
+*  or make the str argument into a struct. */
+#define BLAS_FORTRAN_STRLEN_END
 
-#if defined(_MSC_VER) && defined(__INTEL_CLANG_COMPILER)
-//#define LAPACK_COMPLEX_STRUCTURE
-#define NOCHANGE
-#endif
-/* e.g. mingw64/x86_64-w64-mingw32/include/winerror.h */
-#ifdef FAILED
-#undef FAILED
+#ifndef FORTRAN_STRLEN
+  #define FORTRAN_STRLEN size_t
 #endif
 
 #define  TRUE           1
@@ -33,497 +30,174 @@
 typedef struct { float real; float imag; } CBLAS_TEST_COMPLEX;
 typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX;
 
-#if defined(ADD_)
-/*
- * Level 1 BLAS
- */
-   #define F77_srotg      srotgtest_
-   #define F77_srotmg     srotmgtest_
-   #define F77_srot       srottest_
-   #define F77_srotm      srotmtest_
-   #define F77_drotg      drotgtest_
-   #define F77_drotmg     drotmgtest_
-   #define F77_drot       drottest_
-   #define F77_drotm      drotmtest_
-   #define F77_sswap      sswaptest_
-   #define F77_scopy      scopytest_
-   #define F77_saxpy      saxpytest_
-   #define F77_isamax     isamaxtest_
-   #define F77_dswap      dswaptest_
-   #define F77_dcopy      dcopytest_
-   #define F77_daxpy      daxpytest_
-   #define F77_idamax     idamaxtest_
-   #define F77_cswap      cswaptest_
-   #define F77_ccopy      ccopytest_
-   #define F77_caxpy      caxpytest_
-   #define F77_icamax     icamaxtest_
-   #define F77_zswap      zswaptest_
-   #define F77_zcopy      zcopytest_
-   #define F77_zaxpy      zaxpytest_
-   #define F77_izamax     izamaxtest_
-   #define F77_sdot       sdottest_
-   #define F77_ddot       ddottest_
-   #define F77_dsdot      dsdottest_
-   #define F77_sscal      sscaltest_
-   #define F77_dscal      dscaltest_
-   #define F77_cscal      cscaltest_
-   #define F77_zscal      zscaltest_
-   #define F77_csscal     csscaltest_
-   #define F77_zdscal      zdscaltest_
-   #define F77_cdotu      cdotutest_
-   #define F77_cdotc      cdotctest_
-   #define F77_zdotu      zdotutest_
-   #define F77_zdotc      zdotctest_
-   #define F77_snrm2      snrm2test_
-   #define F77_sasum      sasumtest_
-   #define F77_dnrm2      dnrm2test_
-   #define F77_dasum      dasumtest_
-   #define F77_scnrm2     scnrm2test_
-   #define F77_scasum     scasumtest_
-   #define F77_dznrm2     dznrm2test_
-   #define F77_dzasum     dzasumtest_
-   #define F77_sdsdot     sdsdottest_
-/*
- * Level 2 BLAS
- */
-   #define F77_s2chke     cs2chke_
-   #define F77_d2chke     cd2chke_
-   #define F77_c2chke     cc2chke_
-   #define F77_z2chke     cz2chke_
-   #define F77_ssymv      cssymv_
-   #define F77_ssbmv      cssbmv_
-   #define F77_sspmv      csspmv_
-   #define F77_sger       csger_
-   #define F77_ssyr       cssyr_
-   #define F77_sspr       csspr_
-   #define F77_ssyr2      cssyr2_
-   #define F77_sspr2      csspr2_
-   #define F77_dsymv      cdsymv_
-   #define F77_dsbmv      cdsbmv_
-   #define F77_dspmv      cdspmv_
-   #define F77_dger       cdger_
-   #define F77_dsyr       cdsyr_
-   #define F77_dspr       cdspr_
-   #define F77_dsyr2      cdsyr2_
-   #define F77_dspr2      cdspr2_
-   #define F77_chemv      cchemv_
-   #define F77_chbmv      cchbmv_
-   #define F77_chpmv      cchpmv_
-   #define F77_cgeru      ccgeru_
-   #define F77_cgerc      ccgerc_
-   #define F77_cher       ccher_
-   #define F77_chpr       cchpr_
-   #define F77_cher2      ccher2_
-   #define F77_chpr2      cchpr2_
-   #define F77_zhemv      czhemv_
-   #define F77_zhbmv      czhbmv_
-   #define F77_zhpmv      czhpmv_
-   #define F77_zgeru      czgeru_
-   #define F77_zgerc      czgerc_
-   #define F77_zher       czher_
-   #define F77_zhpr       czhpr_
-   #define F77_zher2      czher2_
-   #define F77_zhpr2      czhpr2_
-   #define F77_sgemv      csgemv_
-   #define F77_sgbmv      csgbmv_
-   #define F77_strmv      cstrmv_
-   #define F77_stbmv      cstbmv_
-   #define F77_stpmv      cstpmv_
-   #define F77_strsv      cstrsv_
-   #define F77_stbsv      cstbsv_
-   #define F77_stpsv      cstpsv_
-   #define F77_dgemv      cdgemv_
-   #define F77_dgbmv      cdgbmv_
-   #define F77_dtrmv      cdtrmv_
-   #define F77_dtbmv      cdtbmv_
-   #define F77_dtpmv      cdtpmv_
-   #define F77_dtrsv      cdtrsv_
-   #define F77_dtbsv      cdtbsv_
-   #define F77_dtpsv      cdtpsv_
-   #define F77_cgemv      ccgemv_
-   #define F77_cgbmv      ccgbmv_
-   #define F77_ctrmv      cctrmv_
-   #define F77_ctbmv      cctbmv_
-   #define F77_ctpmv      cctpmv_
-   #define F77_ctrsv      cctrsv_
-   #define F77_ctbsv      cctbsv_
-   #define F77_ctpsv      cctpsv_
-   #define F77_zgemv      czgemv_
-   #define F77_zgbmv      czgbmv_
-   #define F77_ztrmv      cztrmv_
-   #define F77_ztbmv      cztbmv_
-   #define F77_ztpmv      cztpmv_
-   #define F77_ztrsv      cztrsv_
-   #define F77_ztbsv      cztbsv_
-   #define F77_ztpsv      cztpsv_
-/*
- * Level 3 BLAS
- */
-   #define F77_s3chke     cs3chke_
-   #define F77_d3chke     cd3chke_
-   #define F77_c3chke     cc3chke_
-   #define F77_z3chke     cz3chke_
-   #define F77_chemm      cchemm_
-   #define F77_cherk      ccherk_
-   #define F77_cher2k     ccher2k_
-   #define F77_zhemm      czhemm_
-   #define F77_zherk      czherk_
-   #define F77_zher2k     czher2k_
-   #define F77_sgemm      csgemm_
-   #define F77_ssymm      cssymm_
-   #define F77_ssyrk      cssyrk_
-   #define F77_ssyr2k     cssyr2k_
-   #define F77_strmm      cstrmm_
-   #define F77_strsm      cstrsm_
-   #define F77_dgemm      cdgemm_
-   #define F77_dsymm      cdsymm_
-   #define F77_dsyrk      cdsyrk_
-   #define F77_dsyr2k     cdsyr2k_
-   #define F77_dtrmm      cdtrmm_
-   #define F77_dtrsm      cdtrsm_
-   #define F77_cgemm      ccgemm_
-   #define F77_cgemm3m    ccgemm3m_
-   #define F77_csymm      ccsymm_
-   #define F77_csyrk      ccsyrk_
-   #define F77_csyr2k     ccsyr2k_
-   #define F77_ctrmm      cctrmm_
-   #define F77_ctrsm      cctrsm_
-   #define F77_zgemm      czgemm_
-   #define F77_zgemm3m    czgemm3m_
-   #define F77_zsymm      czsymm_
-   #define F77_zsyrk      czsyrk_
-   #define F77_zsyr2k     czsyr2k_
-   #define F77_ztrmm      cztrmm_
-   #define F77_ztrsm      cztrsm_
-#elif defined(UPCASE)
+//#define F77_xerbla 		F77_GLOBAL(xerbla,XERBLA)
 /*
  * Level 1 BLAS
  */
-   #define F77_srotg      SROTGTEST
-   #define F77_srotmg     SROTMGTEST
-   #define F77_srot       SROTCTEST
-   #define F77_srotm      SROTMTEST
-   #define F77_drotg      DROTGTEST
-   #define F77_drotmg     DROTMGTEST
-   #define F77_drot       DROTTEST
-   #define F77_drotm      DROTMTEST
-   #define F77_sswap      SSWAPTEST
-   #define F77_scopy      SCOPYTEST
-   #define F77_saxpy      SAXPYTEST
-   #define F77_isamax     ISAMAXTEST
-   #define F77_dswap      DSWAPTEST
-   #define F77_dcopy      DCOPYTEST
-   #define F77_daxpy      DAXPYTEST
-   #define F77_idamax     IDAMAXTEST
-   #define F77_cswap      CSWAPTEST
-   #define F77_ccopy      CCOPYTEST
-   #define F77_caxpy      CAXPYTEST
-   #define F77_icamax     ICAMAXTEST
-   #define F77_zswap      ZSWAPTEST
-   #define F77_zcopy      ZCOPYTEST
-   #define F77_zaxpy      ZAXPYTEST
-   #define F77_izamax     IZAMAXTEST
-   #define F77_sdot       SDOTTEST
-   #define F77_ddot       DDOTTEST
-   #define F77_dsdot       DSDOTTEST
-   #define F77_sscal      SSCALTEST
-   #define F77_dscal      DSCALTEST
-   #define F77_cscal      CSCALTEST
-   #define F77_zscal      ZSCALTEST
-   #define F77_csscal      CSSCALTEST
-   #define F77_zdscal      ZDSCALTEST
-   #define F77_cdotu      CDOTUTEST
-   #define F77_cdotc      CDOTCTEST
-   #define F77_zdotu      ZDOTUTEST
-   #define F77_zdotc      ZDOTCTEST
-   #define F77_snrm2      SNRM2TEST
-   #define F77_sasum      SASUMTEST
-   #define F77_dnrm2      DNRM2TEST
-   #define F77_dasum      DASUMTEST
-   #define F77_scnrm2      SCNRM2TEST
-   #define F77_scasum      SCASUMTEST
-   #define F77_dznrm2      DZNRM2TEST
-   #define F77_dzasum      DZASUMTEST
-   #define F77_sdsdot       SDSDOTTEST
+#define F77_srotg 		F77_GLOBAL(srotgtest,SROTGTEST)
+#define F77_srotmg 		F77_GLOBAL(srotmgtest,SROTMGTEST)
+#define F77_srot 		F77_GLOBAL(srottest,SROTTEST)
+#define F77_srotm 		F77_GLOBAL(srotmtest,SROTMTEST)
+#define F77_drotg 		F77_GLOBAL(drotgtest,DROTGTEST)
+#define F77_drotmg 		F77_GLOBAL(drotmgtest,DROTMGTEST)
+#define F77_drot 		F77_GLOBAL(drottest,DROTTEST)
+#define F77_drotm 		F77_GLOBAL(drotmtest,DROTMTEST)
+#define F77_sswap 		F77_GLOBAL(sswaptest,SSWAPTEST)
+#define F77_scopy 		F77_GLOBAL(scopytest,SCOPYTEST)
+#define F77_saxpy 		F77_GLOBAL(saxpytest,SAXPYTEST)
+#define F77_isamax 		F77_GLOBAL(isamaxtest,ISAMAXTEST)
+#define F77_dswap 		F77_GLOBAL(dswaptest,DSWAPTEST)
+#define F77_dcopy 		F77_GLOBAL(dcopytest,DCOPYTEST)
+#define F77_daxpy 		F77_GLOBAL(daxpytest,DAXPYTEST)
+#define F77_idamax 		F77_GLOBAL(idamaxtest,IDAMAXTEST)
+#define F77_cswap 		F77_GLOBAL(cswaptest,CSWAPTEST)
+#define F77_ccopy 		F77_GLOBAL(ccopytest,CCOPYTEST)
+#define F77_caxpy 		F77_GLOBAL(caxpytest,CAXPYTEST)
+#define F77_icamax 		F77_GLOBAL(icamaxtest,ICAMAXTEST)
+#define F77_zswap 		F77_GLOBAL(zswaptest,ZSWAPTEST)
+#define F77_zcopy 		F77_GLOBAL(zcopytest,ZCOPYTEST)
+#define F77_zaxpy 		F77_GLOBAL(zaxpytest,ZAXPYTEST)
+#define F77_izamax 		F77_GLOBAL(izamaxtest,IZAMAXTEST)
+#define F77_sdot 		F77_GLOBAL(sdottest,SDOTTEST)
+#define F77_ddot 		F77_GLOBAL(ddottest,DDOTTEST)
+#define F77_dsdot 		F77_GLOBAL(dsdottest,DSDOTTEST)
+#define F77_sscal 		F77_GLOBAL(sscaltest,SSCALTEST)
+#define F77_dscal 		F77_GLOBAL(dscaltest,DSCALTEST)
+#define F77_cscal 		F77_GLOBAL(cscaltest,CSCALTEST)
+#define F77_zscal 		F77_GLOBAL(zscaltest,ZSCALTEST)
+#define F77_csscal 		F77_GLOBAL(csscaltest,CSSCALTEST)
+#define F77_zdscal 		F77_GLOBAL(zdscaltest,ZDSCALTEST)
+#define F77_cdotu 		F77_GLOBAL(cdotutest,CDOTUTEST)
+#define F77_cdotc 		F77_GLOBAL(cdotctest,CDOTCTEST)
+#define F77_zdotu 		F77_GLOBAL(zdotutest,ZDOTUTEST)
+#define F77_zdotc 		F77_GLOBAL(zdotctest,ZDOTCTEST)
+#define F77_snrm2 		F77_GLOBAL(snrm2test,SNRM2TEST)
+#define F77_sasum 		F77_GLOBAL(sasumtest,SASUMTEST)
+#define F77_dnrm2 		F77_GLOBAL(dnrm2test,DNRM2TEST)
+#define F77_dasum 		F77_GLOBAL(dasumtest,DASUMTEST)
+#define F77_scnrm2 		F77_GLOBAL(scnrm2test,SCNRM2TEST)
+#define F77_scasum 		F77_GLOBAL(scasumtest,SCASUMTEST)
+#define F77_dznrm2 		F77_GLOBAL(dznrm2test,DZNRM2TEST)
+#define F77_dzasum 		F77_GLOBAL(dzasumtest,DZASUMTEST)
+#define F77_sdsdot 		F77_GLOBAL(sdsdottest, SDSDOTTEST)
 /*
  * Level 2 BLAS
  */
-   #define F77_s2chke     CS2CHKE
-   #define F77_d2chke     CD2CHKE
-   #define F77_c2chke     CC2CHKE
-   #define F77_z2chke     CZ2CHKE
-   #define F77_ssymv      CSSYMV
-   #define F77_ssbmv      CSSBMV
-   #define F77_sspmv      CSSPMV
-   #define F77_sger       CSGER
-   #define F77_ssyr       CSSYR
-   #define F77_sspr       CSSPR
-   #define F77_ssyr2      CSSYR2
-   #define F77_sspr2      CSSPR2
-   #define F77_dsymv      CDSYMV
-   #define F77_dsbmv      CDSBMV
-   #define F77_dspmv      CDSPMV
-   #define F77_dger       CDGER
-   #define F77_dsyr       CDSYR
-   #define F77_dspr       CDSPR
-   #define F77_dsyr2      CDSYR2
-   #define F77_dspr2      CDSPR2
-   #define F77_chemv      CCHEMV
-   #define F77_chbmv      CCHBMV
-   #define F77_chpmv      CCHPMV
-   #define F77_cgeru      CCGERU
-   #define F77_cgerc      CCGERC
-   #define F77_cher       CCHER
-   #define F77_chpr       CCHPR
-   #define F77_cher2      CCHER2
-   #define F77_chpr2      CCHPR2
-   #define F77_zhemv      CZHEMV
-   #define F77_zhbmv      CZHBMV
-   #define F77_zhpmv      CZHPMV
-   #define F77_zgeru      CZGERU
-   #define F77_zgerc      CZGERC
-   #define F77_zher       CZHER
-   #define F77_zhpr       CZHPR
-   #define F77_zher2      CZHER2
-   #define F77_zhpr2      CZHPR2
-   #define F77_sgemv      CSGEMV
-   #define F77_sgbmv      CSGBMV
-   #define F77_strmv      CSTRMV
-   #define F77_stbmv      CSTBMV
-   #define F77_stpmv      CSTPMV
-   #define F77_strsv      CSTRSV
-   #define F77_stbsv      CSTBSV
-   #define F77_stpsv      CSTPSV
-   #define F77_dgemv      CDGEMV
-   #define F77_dgbmv      CDGBMV
-   #define F77_dtrmv      CDTRMV
-   #define F77_dtbmv      CDTBMV
-   #define F77_dtpmv      CDTPMV
-   #define F77_dtrsv      CDTRSV
-   #define F77_dtbsv      CDTBSV
-   #define F77_dtpsv      CDTPSV
-   #define F77_cgemv      CCGEMV
-   #define F77_cgbmv      CCGBMV
-   #define F77_ctrmv      CCTRMV
-   #define F77_ctbmv      CCTBMV
-   #define F77_ctpmv      CCTPMV
-   #define F77_ctrsv      CCTRSV
-   #define F77_ctbsv      CCTBSV
-   #define F77_ctpsv      CCTPSV
-   #define F77_zgemv      CZGEMV
-   #define F77_zgbmv      CZGBMV
-   #define F77_ztrmv      CZTRMV
-   #define F77_ztbmv      CZTBMV
-   #define F77_ztpmv      CZTPMV
-   #define F77_ztrsv      CZTRSV
-   #define F77_ztbsv      CZTBSV
-   #define F77_ztpsv      CZTPSV
+#define F77_s2chke 		F77_GLOBAL(cs2chke,CS2CHKE)
+#define F77_d2chke 		F77_GLOBAL(cd2chke,CD2CHKE)
+#define F77_c2chke 		F77_GLOBAL(cc2chke,CC2CHKE)
+#define F77_z2chke 		F77_GLOBAL(cz2chke,CZ2CHKE)
+#define F77_ssymv 		F77_GLOBAL(cssymv,CSSYMV)
+#define F77_ssbmv 		F77_GLOBAL(cssbmv,CSSBMV)
+#define F77_sspmv 		F77_GLOBAL(csspmv,CSSPMV)
+#define F77_sger 		F77_GLOBAL(csger,CSGER)
+#define F77_ssyr 		F77_GLOBAL(cssyr,CSSYR)
+#define F77_sspr 		F77_GLOBAL(csspr,CSSPR)
+#define F77_ssyr2 		F77_GLOBAL(cssyr2,CSSYR2)
+#define F77_sspr2 		F77_GLOBAL(csspr2,CSSPR2)
+#define F77_dsymv 		F77_GLOBAL(cdsymv,CDSYMV)
+#define F77_dsbmv 		F77_GLOBAL(cdsbmv,CDSBMV)
+#define F77_dspmv 		F77_GLOBAL(cdspmv,CDSPMV)
+#define F77_dger 		F77_GLOBAL(cdger,CDGER)
+#define F77_dsyr 		F77_GLOBAL(cdsyr,CDSYR)
+#define F77_dspr 		F77_GLOBAL(cdspr,CDSPR)
+#define F77_dsyr2 		F77_GLOBAL(cdsyr2,CDSYR2)
+#define F77_dspr2 		F77_GLOBAL(cdspr2,CDSPR2)
+#define F77_chemv 		F77_GLOBAL(cchemv,CCHEMV)
+#define F77_chbmv 		F77_GLOBAL(cchbmv,CCHBMV)
+#define F77_chpmv 		F77_GLOBAL(cchpmv,CCHPMV)
+#define F77_cgeru 		F77_GLOBAL(ccgeru,CCGERU)
+#define F77_cgerc 		F77_GLOBAL(ccgerc,CCGERC)
+#define F77_cher 		F77_GLOBAL(ccher,CCHER)
+#define F77_chpr 		F77_GLOBAL(cchpr,CCHPR)
+#define F77_cher2 		F77_GLOBAL(ccher2,CCHER2)
+#define F77_chpr2 		F77_GLOBAL(cchpr2,CCHPR2)
+#define F77_zhemv 		F77_GLOBAL(czhemv,CZHEMV)
+#define F77_zhbmv 		F77_GLOBAL(czhbmv,CZHBMV)
+#define F77_zhpmv 		F77_GLOBAL(czhpmv,CZHPMV)
+#define F77_zgeru 		F77_GLOBAL(czgeru,CZGERU)
+#define F77_zgerc 		F77_GLOBAL(czgerc,CZGERC)
+#define F77_zher 		F77_GLOBAL(czher,CZHER)
+#define F77_zhpr 		F77_GLOBAL(czhpr,CZHPR)
+#define F77_zher2 		F77_GLOBAL(czher2,CZHER2)
+#define F77_zhpr2 		F77_GLOBAL(czhpr2,CZHPR2)
+#define F77_sgemv 		F77_GLOBAL(csgemv,CSGEMV)
+#define F77_sgbmv 		F77_GLOBAL(csgbmv,CSGBMV)
+#define F77_strmv 		F77_GLOBAL(cstrmv,CSTRMV)
+#define F77_stbmv 		F77_GLOBAL(cstbmv,CSTBMV)
+#define F77_stpmv 		F77_GLOBAL(cstpmv,CSTPMV)
+#define F77_strsv 		F77_GLOBAL(cstrsv,CSTRSV)
+#define F77_stbsv 		F77_GLOBAL(cstbsv,CSTBSV)
+#define F77_stpsv 		F77_GLOBAL(cstpsv,CSTPSV)
+#define F77_dgemv 		F77_GLOBAL(cdgemv,CDGEMV)
+#define F77_dgbmv 		F77_GLOBAL(cdgbmv,CDGBMV)
+#define F77_dtrmv 		F77_GLOBAL(cdtrmv,CDTRMV)
+#define F77_dtbmv 		F77_GLOBAL(cdtbmv,CDTBMV)
+#define F77_dtpmv 		F77_GLOBAL(cdtpmv,CDTPMV)
+#define F77_dtrsv 		F77_GLOBAL(cdtrsv,CDTRSV)
+#define F77_dtbsv 		F77_GLOBAL(cdtbsv,CDTBSV)
+#define F77_dtpsv 		F77_GLOBAL(cdtpsv,CDTPSV)
+#define F77_cgemv 		F77_GLOBAL(ccgemv,CCGEMV)
+#define F77_cgbmv 		F77_GLOBAL(ccgbmv,CCGBMV)
+#define F77_ctrmv 		F77_GLOBAL(cctrmv,CCTRMV)
+#define F77_ctbmv 		F77_GLOBAL(cctbmv,CCTBMV)
+#define F77_ctpmv 		F77_GLOBAL(cctpmv,CCTPMV)
+#define F77_ctrsv 		F77_GLOBAL(cctrsv,CCTRSV)
+#define F77_ctbsv 		F77_GLOBAL(cctbsv,CCTBSV)
+#define F77_ctpsv 		F77_GLOBAL(cctpsv,CCTPSV)
+#define F77_zgemv 		F77_GLOBAL(czgemv,CZGEMV)
+#define F77_zgbmv 		F77_GLOBAL(czgbmv,CZGBMV)
+#define F77_ztrmv 		F77_GLOBAL(cztrmv,CZTRMV)
+#define F77_ztbmv 		F77_GLOBAL(cztbmv,CZTBMV)
+#define F77_ztpmv 		F77_GLOBAL(cztpmv,CZTPMV)
+#define F77_ztrsv 		F77_GLOBAL(cztrsv,CZTRSV)
+#define F77_ztbsv 		F77_GLOBAL(cztbsv,CZTBSV)
+#define F77_ztpsv 		F77_GLOBAL(cztpsv,CZTPSV)
 /*
  * Level 3 BLAS
  */
-   #define F77_s3chke     CS3CHKE
-   #define F77_d3chke     CD3CHKE
-   #define F77_c3chke     CC3CHKE
-   #define F77_z3chke     CZ3CHKE
-   #define F77_chemm      CCHEMM
-   #define F77_cherk      CCHERK
-   #define F77_cher2k     CCHER2K
-   #define F77_zhemm      CZHEMM
-   #define F77_zherk      CZHERK
-   #define F77_zher2k     CZHER2K
-   #define F77_sgemm      CSGEMM
-   #define F77_ssymm      CSSYMM
-   #define F77_ssyrk      CSSYRK
-   #define F77_ssyr2k     CSSYR2K
-   #define F77_strmm      CSTRMM
-   #define F77_strsm      CSTRSM
-   #define F77_dgemm      CDGEMM
-   #define F77_dsymm      CDSYMM
-   #define F77_dsyrk      CDSYRK
-   #define F77_dsyr2k     CDSYR2K
-   #define F77_dtrmm      CDTRMM
-   #define F77_dtrsm      CDTRSM
-   #define F77_cgemm      CCGEMM
-   #define F77_cgemm3m    CCGEMM3M
-   #define F77_csymm      CCSYMM
-   #define F77_csyrk      CCSYRK
-   #define F77_csyr2k     CCSYR2K
-   #define F77_ctrmm      CCTRMM
-   #define F77_ctrsm      CCTRSM
-   #define F77_zgemm      CZGEMM
-   #define F77_zgemm3m    CZGEMM3M
-   #define F77_zsymm      CZSYMM
-   #define F77_zsyrk      CZSYRK
-   #define F77_zsyr2k     CZSYR2K
-   #define F77_ztrmm      CZTRMM
-   #define F77_ztrsm      CZTRSM
-#elif defined(NOCHANGE)
-/*
- * Level 1 BLAS
- */
-   #define F77_srotg      srotgtest
-   #define F77_srotmg     srotmgtest
-   #define F77_srot       srottest
-   #define F77_srotm      srotmtest
-   #define F77_drotg      drotgtest
-   #define F77_drotmg     drotmgtest
-   #define F77_drot       drottest
-   #define F77_drotm      drotmtest
-   #define F77_sswap      sswaptest
-   #define F77_scopy      scopytest
-   #define F77_saxpy      saxpytest
-   #define F77_isamax     isamaxtest
-   #define F77_dswap      dswaptest
-   #define F77_dcopy      dcopytest
-   #define F77_daxpy      daxpytest
-   #define F77_idamax     idamaxtest
-   #define F77_cswap      cswaptest
-   #define F77_ccopy      ccopytest
-   #define F77_caxpy      caxpytest
-   #define F77_icamax     icamaxtest
-   #define F77_zswap      zswaptest
-   #define F77_zcopy      zcopytest
-   #define F77_zaxpy      zaxpytest
-   #define F77_izamax     izamaxtest
-   #define F77_sdot       sdottest
-   #define F77_ddot       ddottest
-   #define F77_dsdot       dsdottest
-   #define F77_sscal      sscaltest
-   #define F77_dscal      dscaltest
-   #define F77_cscal      cscaltest
-   #define F77_zscal      zscaltest
-   #define F77_csscal      csscaltest
-   #define F77_zdscal      zdscaltest
-   #define F77_cdotu  cdotutest
-   #define F77_cdotc  cdotctest
-   #define F77_zdotu  zdotutest
-   #define F77_zdotc  zdotctest
-   #define F77_snrm2  snrm2test
-   #define F77_sasum  sasumtest
-   #define F77_dnrm2  dnrm2test
-   #define F77_dasum  dasumtest
-   #define F77_scnrm2  scnrm2test
-   #define F77_scasum  scasumtest
-   #define F77_dznrm2  dznrm2test
-   #define F77_dzasum  dzasumtest
-   #define F77_sdsdot   sdsdottest
-/*
- * Level 2 BLAS
- */
-   #define F77_s2chke     cs2chke
-   #define F77_d2chke     cd2chke
-   #define F77_c2chke     cc2chke
-   #define F77_z2chke     cz2chke
-   #define F77_ssymv      cssymv
-   #define F77_ssbmv      cssbmv
-   #define F77_sspmv      csspmv
-   #define F77_sger       csger
-   #define F77_ssyr       cssyr
-   #define F77_sspr       csspr
-   #define F77_ssyr2      cssyr2
-   #define F77_sspr2      csspr2
-   #define F77_dsymv      cdsymv
-   #define F77_dsbmv      cdsbmv
-   #define F77_dspmv      cdspmv
-   #define F77_dger       cdger
-   #define F77_dsyr       cdsyr
-   #define F77_dspr       cdspr
-   #define F77_dsyr2      cdsyr2
-   #define F77_dspr2      cdspr2
-   #define F77_chemv      cchemv
-   #define F77_chbmv      cchbmv
-   #define F77_chpmv      cchpmv
-   #define F77_cgeru      ccgeru
-   #define F77_cgerc      ccgerc
-   #define F77_cher       ccher
-   #define F77_chpr       cchpr
-   #define F77_cher2      ccher2
-   #define F77_chpr2      cchpr2
-   #define F77_zhemv      czhemv
-   #define F77_zhbmv      czhbmv
-   #define F77_zhpmv      czhpmv
-   #define F77_zgeru      czgeru
-   #define F77_zgerc      czgerc
-   #define F77_zher       czher
-   #define F77_zhpr       czhpr
-   #define F77_zher2      czher2
-   #define F77_zhpr2      czhpr2
-   #define F77_sgemv      csgemv
-   #define F77_sgbmv      csgbmv
-   #define F77_strmv      cstrmv
-   #define F77_stbmv      cstbmv
-   #define F77_stpmv      cstpmv
-   #define F77_strsv      cstrsv
-   #define F77_stbsv      cstbsv
-   #define F77_stpsv      cstpsv
-   #define F77_dgemv      cdgemv
-   #define F77_dgbmv      cdgbmv
-   #define F77_dtrmv      cdtrmv
-   #define F77_dtbmv      cdtbmv
-   #define F77_dtpmv      cdtpmv
-   #define F77_dtrsv      cdtrsv
-   #define F77_dtbsv      cdtbsv
-   #define F77_dtpsv      cdtpsv
-   #define F77_cgemv      ccgemv
-   #define F77_cgbmv      ccgbmv
-   #define F77_ctrmv      cctrmv
-   #define F77_ctbmv      cctbmv
-   #define F77_ctpmv      cctpmv
-   #define F77_ctrsv      cctrsv
-   #define F77_ctbsv      cctbsv
-   #define F77_ctpsv      cctpsv
-   #define F77_zgemv      czgemv
-   #define F77_zgbmv      czgbmv
-   #define F77_ztrmv      cztrmv
-   #define F77_ztbmv      cztbmv
-   #define F77_ztpmv      cztpmv
-   #define F77_ztrsv      cztrsv
-   #define F77_ztbsv      cztbsv
-   #define F77_ztpsv      cztpsv
-/*
- * Level 3 BLAS
- */
-   #define F77_s3chke     cs3chke
-   #define F77_d3chke     cd3chke
-   #define F77_c3chke     cc3chke
-   #define F77_z3chke     cz3chke
-   #define F77_chemm      cchemm
-   #define F77_cherk      ccherk
-   #define F77_cher2k     ccher2k
-   #define F77_zhemm      czhemm
-   #define F77_zherk      czherk
-   #define F77_zher2k     czher2k
-   #define F77_sgemm      csgemm
-   #define F77_ssymm      cssymm
-   #define F77_ssyrk      cssyrk
-   #define F77_ssyr2k     cssyr2k
-   #define F77_strmm      cstrmm
-   #define F77_strsm      cstrsm
-   #define F77_dgemm      cdgemm
-   #define F77_dsymm      cdsymm
-   #define F77_dsyrk      cdsyrk
-   #define F77_dsyr2k     cdsyr2k
-   #define F77_dtrmm      cdtrmm
-   #define F77_dtrsm      cdtrsm
-   #define F77_cgemm      ccgemm
-   #define F77_cgemm3m    ccgemm3m
-   #define F77_csymm      ccsymm
-   #define F77_csyrk      ccsyrk
-   #define F77_csyr2k     ccsyr2k
-   #define F77_ctrmm      cctrmm
-   #define F77_ctrsm      cctrsm
-   #define F77_zgemm      czgemm
-   #define F77_zgemm3m    czgemm3m
-   #define F77_zsymm      czsymm
-   #define F77_zsyrk      czsyrk
-   #define F77_zsyr2k     czsyr2k
-   #define F77_ztrmm      cztrmm
-   #define F77_ztrsm      cztrsm
-#endif
+#define F77_s3chke 		F77_GLOBAL(cs3chke,CS3CHKE)
+#define F77_d3chke 		F77_GLOBAL(cd3chke,CD3CHKE)
+#define F77_c3chke 		F77_GLOBAL(cc3chke,CC3CHKE)
+#define F77_z3chke 		F77_GLOBAL(cz3chke,CZ3CHKE)
+#define F77_chemm 		F77_GLOBAL(cchemm,CCHEMM)
+#define F77_cherk 		F77_GLOBAL(ccherk,CCHERK)
+#define F77_cher2k 		F77_GLOBAL(ccher2k,CCHER2K)
+#define F77_zhemm 		F77_GLOBAL(czhemm,CZHEMM)
+#define F77_zherk 		F77_GLOBAL(czherk,CZHERK)
+#define F77_zher2k 		F77_GLOBAL(czher2k,CZHER2K)
+#define F77_sgemm 		F77_GLOBAL(csgemm,CSGEMM)
+#define F77_sgemmtr 		F77_GLOBAL(csgemmtr,CSGEMMTR)
+#define F77_ssymm 		F77_GLOBAL(cssymm,CSSYMM)
+#define F77_ssyrk 		F77_GLOBAL(cssyrk,CSSYRK)
+#define F77_ssyr2k 		F77_GLOBAL(cssyr2k,CSSYR2K)
+#define F77_strmm 		F77_GLOBAL(cstrmm,CSTRMM)
+#define F77_strsm 		F77_GLOBAL(cstrsm,CSTRSM)
+#define F77_dgemm 		F77_GLOBAL(cdgemm,CDGEMM)
+#define F77_dgemmtr 		F77_GLOBAL(cdgemmtr,CDGEMMTR)
+#define F77_dsymm 		F77_GLOBAL(cdsymm,CDSYMM)
+#define F77_dsyrk 		F77_GLOBAL(cdsyrk,CDSYRK)
+#define F77_dsyr2k 		F77_GLOBAL(cdsyr2k,CDSYR2K)
+#define F77_dtrmm 		F77_GLOBAL(cdtrmm,CDTRMM)
+#define F77_dtrsm 		F77_GLOBAL(cdtrsm,CDTRSM)
+#define F77_cgemm 		F77_GLOBAL(ccgemm,CCGEMM)
+#define F77_cgemmtr 		F77_GLOBAL(ccgemmtr,CCGEMMTR)
+#define F77_csymm 		F77_GLOBAL(ccsymm,CCSYMM)
+#define F77_csyrk 		F77_GLOBAL(ccsyrk,CCSYRK)
+#define F77_csyr2k 		F77_GLOBAL(ccsyr2k,CCSYR2K)
+#define F77_ctrmm 		F77_GLOBAL(cctrmm,CCTRMM)
+#define F77_ctrsm 		F77_GLOBAL(cctrsm,CCTRSM)
+#define F77_zgemm 		F77_GLOBAL(czgemm,CZGEMM)
+#define F77_zgemmtr 		F77_GLOBAL(czgemmtr,CZGEMMTR)
+#define F77_zsymm 		F77_GLOBAL(czsymm,CZSYMM)
+#define F77_zsyrk 		F77_GLOBAL(czsyrk,CZSYRK)
+#define F77_zsyr2k 		F77_GLOBAL(czsyr2k,CZSYR2K)
+#define F77_ztrmm 		F77_GLOBAL(cztrmm,CZTRMM)
+#define F77_ztrsm 		F77_GLOBAL(cztrsm, CZTRSM)
 
-void get_transpose_type(char *type, enum CBLAS_TRANSPOSE *trans);
-void get_uplo_type(char *type, enum CBLAS_UPLO *uplo);
-void get_diag_type(char *type, enum CBLAS_DIAG *diag);
-void get_side_type(char *type, enum CBLAS_SIDE *side);
+void get_transpose_type(char *type, CBLAS_TRANSPOSE *trans);
+void get_uplo_type(char *type, CBLAS_UPLO *uplo);
+void get_diag_type(char *type, CBLAS_DIAG *diag);
+void get_side_type(char *type, CBLAS_SIDE *side);
 
 #endif /* CBLAS_TEST_H */

ctest/cin3

@@ -1,12 +1,12 @@
 'CBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
 -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
 F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
-T        LOGICAL FLAG, T TO STOP ON FAILURES.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
 T        LOGICAL FLAG, T TO TEST ERROR EXITS.
 2        0 TO TEST COLUMN-MAJOR, 1 TO TEST ROW-MAJOR, 2 TO TEST BOTH
 16.0     THRESHOLD VALUE OF TEST RATIO
 6                 NUMBER OF VALUES OF N
-0 1 2 3 5 9 35    VALUES OF N
+0 1 2 3 5 9       VALUES OF N
 3                 NUMBER OF VALUES OF ALPHA
 (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
 3                 NUMBER OF VALUES OF BETA
@@ -20,3 +20,4 @@ cblas_cherk  T PUT F FOR NO TEST. SAME COLUMNS.
 cblas_csyrk  T PUT F FOR NO TEST. SAME COLUMNS.
 cblas_cher2k T PUT F FOR NO TEST. SAME COLUMNS.
 cblas_csyr2k T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_cgemmtr T PUT F FOR NO TEST. SAME COLUMNS.

ctest/din3

@@ -1,19 +1,20 @@
 'DBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
 -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
 F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
-T        LOGICAL FLAG, T TO STOP ON FAILURES.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
 T        LOGICAL FLAG, T TO TEST ERROR EXITS.
 2        0 TO TEST COLUMN-MAJOR, 1 TO TEST ROW-MAJOR, 2 TO TEST BOTH
 16.0     THRESHOLD VALUE OF TEST RATIO
-7                 NUMBER OF VALUES OF N
-1 2 3 5 7 9 35    VALUES OF N
+6                 NUMBER OF VALUES OF N
+1 2 3 5 7 9       VALUES OF N
 3                 NUMBER OF VALUES OF ALPHA
 0.0 1.0 0.7       VALUES OF ALPHA
 3                 NUMBER OF VALUES OF BETA
 0.0 1.0 1.3       VALUES OF BETA
-cblas_dgemm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_dsymm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_dtrmm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_dtrsm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_dsyrk  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_dsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_dgemm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_dsymm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_dtrmm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_dtrsm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_dsyrk   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_dsyr2k  T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_dgemmtr T PUT F FOR NO TEST. SAME COLUMNS.

ctest/sin3

@@ -1,19 +1,20 @@
 'SBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
 -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
 F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
-T        LOGICAL FLAG, T TO STOP ON FAILURES.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
 T        LOGICAL FLAG, T TO TEST ERROR EXITS.
 2        0 TO TEST COLUMN-MAJOR, 1 TO TEST ROW-MAJOR, 2 TO TEST BOTH
 16.0     THRESHOLD VALUE OF TEST RATIO
-7                 NUMBER OF VALUES OF N
-0 1 2 3 5 9 35    VALUES OF N
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
 3                 NUMBER OF VALUES OF ALPHA
 0.0 1.0 0.7       VALUES OF ALPHA
 3                 NUMBER OF VALUES OF BETA
 0.0 1.0 1.3       VALUES OF BETA
-cblas_sgemm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_ssymm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_strmm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_strsm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_ssyrk  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_ssyr2k T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_sgemm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_ssymm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_strmm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_strsm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_ssyrk   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_ssyr2k  T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_sgemmtr T PUT F FOR NO TEST. SAME COLUMNS.

ctest/zin3

@@ -1,22 +1,23 @@
 'ZBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
 -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
 F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
-T        LOGICAL FLAG, T TO STOP ON FAILURES.
+F        LOGICAL FLAG, T TO STOP ON FAILURES.
 T        LOGICAL FLAG, T TO TEST ERROR EXITS.
 2        0 TO TEST COLUMN-MAJOR, 1 TO TEST ROW-MAJOR, 2 TO TEST BOTH
 16.0     THRESHOLD VALUE OF TEST RATIO
-7                 NUMBER OF VALUES OF N
-0 1 2 3 5 9 35    VALUES OF N
+6                 NUMBER OF VALUES OF N
+0 1 2 3 5 9       VALUES OF N
 3                 NUMBER OF VALUES OF ALPHA
 (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
 3                 NUMBER OF VALUES OF BETA
 (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
-cblas_zgemm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_zhemm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_zsymm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_ztrmm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_ztrsm  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_zherk  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_zsyrk  T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_zher2k T PUT F FOR NO TEST. SAME COLUMNS.
-cblas_zsyr2k T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zgemm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zhemm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zsymm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_ztrmm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_ztrsm   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zherk   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zsyrk   T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zher2k  T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zsyr2k  T PUT F FOR NO TEST. SAME COLUMNS.
+cblas_zgemmtr T PUT F FOR NO TEST. SAME COLUMNS.