1 /* 2 * 3 * cblas_strmm.c 4 * This program is a C interface to strmm. 5 * Written by Keita Teranishi 6 * 4/6/1998 7 * 8 */ 9 10 #include "cblas.h" 11 #include "cblas_f77.h" 12 void cblas_strmm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side, 13 const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA, 14 const enum CBLAS_DIAG Diag, const int M, const int N, 15 const float alpha, const float *A, const int lda, 16 float *B, const int ldb) 17 { 18 char UL, TA, SD, DI; 19 #ifdef F77_CHAR 20 F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI; 21 #else 22 #define F77_TA &TA 23 #define F77_UL &UL 24 #define F77_SD &SD 25 #define F77_DI &DI 26 #endif 27 28 #ifdef F77_INT 29 F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb; 30 #else 31 #define F77_M M 32 #define F77_N N 33 #define F77_lda lda 34 #define F77_ldb ldb 35 #endif 36 37 extern int CBLAS_CallFromC; 38 extern int RowMajorStrg; 39 RowMajorStrg = 0; 40 CBLAS_CallFromC = 1; 41 42 if( Order == CblasColMajor ) 43 { 44 if( Side == CblasRight) SD='R'; 45 else if ( Side == CblasLeft ) SD='L'; 46 else 47 { 48 cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side); 49 CBLAS_CallFromC = 0; 50 RowMajorStrg = 0; 51 return; 52 } 53 if( Uplo == CblasUpper) UL='U'; 54 else if ( Uplo == CblasLower ) UL='L'; 55 else 56 { 57 cblas_xerbla(3, "cblas_strmm","Illegal Uplo setting, %d\n", Uplo); 58 CBLAS_CallFromC = 0; 59 RowMajorStrg = 0; 60 return; 61 } 62 63 if( TransA == CblasTrans) TA ='T'; 64 else if ( TransA == CblasConjTrans ) TA='C'; 65 else if ( TransA == CblasNoTrans ) TA='N'; 66 else 67 { 68 cblas_xerbla(4, "cblas_strmm","Illegal Trans setting, %d\n", TransA); 69 CBLAS_CallFromC = 0; 70 RowMajorStrg = 0; 71 return; 72 } 73 74 if( Diag == CblasUnit ) DI='U'; 75 else if ( Diag == CblasNonUnit ) DI='N'; 76 else 77 { 78 cblas_xerbla(5, "cblas_strmm", "Illegal Diag setting, %d\n", Diag); 79 CBLAS_CallFromC = 0; 80 RowMajorStrg = 0; 81 return; 82 } 83 84 #ifdef F77_CHAR 85 F77_UL = C2F_CHAR(&UL); 86 F77_TA = C2F_CHAR(&TA); 87 F77_SD = C2F_CHAR(&SD); 88 F77_DI = C2F_CHAR(&DI); 89 #endif 90 91 F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, &alpha, A, &F77_lda, B, &F77_ldb); 92 } else if (Order == CblasRowMajor) 93 { 94 RowMajorStrg = 1; 95 if( Side == CblasRight) SD='L'; 96 else if ( Side == CblasLeft ) SD='R'; 97 else 98 { 99 cblas_xerbla(2, "cblas_strmm","Illegal Side setting, %d\n", Side); 100 CBLAS_CallFromC = 0; 101 RowMajorStrg = 0; 102 return; 103 } 104 105 if( Uplo == CblasUpper) UL='L'; 106 else if ( Uplo == CblasLower ) UL='U'; 107 else 108 { 109 cblas_xerbla(3, "cblas_strmm", "Illegal Uplo setting, %d\n", Uplo); 110 CBLAS_CallFromC = 0; 111 RowMajorStrg = 0; 112 return; 113 } 114 115 if( TransA == CblasTrans) TA ='T'; 116 else if ( TransA == CblasConjTrans ) TA='C'; 117 else if ( TransA == CblasNoTrans ) TA='N'; 118 else 119 { 120 cblas_xerbla(4, "cblas_strmm", "Illegal Trans setting, %d\n", TransA); 121 CBLAS_CallFromC = 0; 122 RowMajorStrg = 0; 123 return; 124 } 125 126 if( Diag == CblasUnit ) DI='U'; 127 else if ( Diag == CblasNonUnit ) DI='N'; 128 else 129 { 130 cblas_xerbla(5, "cblas_strmm","Illegal Diag setting, %d\n", Diag); 131 CBLAS_CallFromC = 0; 132 RowMajorStrg = 0; 133 return; 134 } 135 #ifdef F77_CHAR 136 F77_UL = C2F_CHAR(&UL); 137 F77_TA = C2F_CHAR(&TA); 138 F77_SD = C2F_CHAR(&SD); 139 F77_DI = C2F_CHAR(&DI); 140 #endif 141 F77_strmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, &alpha, A, 142 &F77_lda, B, &F77_ldb); 143 } 144 else cblas_xerbla(1, "cblas_strmm", "Illegal Order setting, %d\n", Order); 145 CBLAS_CallFromC = 0; 146 RowMajorStrg = 0; 147 return; 148 } 149
