1 /* 2 * 3 * cblas_ctrmm.c 4 * This program is a C interface to ctrmm. 5 * Written by Keita Teranishi 6 * 4/8/1998 7 * 8 */ 9 10 #include "cblas.h" 11 #include "cblas_f77.h" cblas_ctrmm(const enum CBLAS_ORDER Order,const enum CBLAS_SIDE Side,const enum CBLAS_UPLO Uplo,const enum CBLAS_TRANSPOSE TransA,const enum CBLAS_DIAG Diag,const int M,const int N,const void * alpha,const void * A,const int lda,void * B,const int ldb)12 void cblas_ctrmm(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 void *alpha, const void *A, const int lda, 16 void *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_ctrmm", "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_ctrmm", "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_ctrmm", "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 cblas_xerbla(5, "cblas_ctrmm", 77 "Illegal Diag setting, %d\n", Diag); 78 79 #ifdef F77_CHAR 80 F77_UL = C2F_CHAR(&UL); 81 F77_TA = C2F_CHAR(&TA); 82 F77_SD = C2F_CHAR(&SD); 83 F77_DI = C2F_CHAR(&DI); 84 #endif 85 86 F77_ctrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A, &F77_lda, B, &F77_ldb); 87 } else if (Order == CblasRowMajor) 88 { 89 RowMajorStrg = 1; 90 if( Side == CblasRight ) SD='L'; 91 else if ( Side == CblasLeft ) SD='R'; 92 else 93 { 94 cblas_xerbla(2, "cblas_ctrmm", "Illegal Side setting, %d\n", Side); 95 CBLAS_CallFromC = 0; 96 RowMajorStrg = 0; 97 return; 98 } 99 100 if( Uplo == CblasUpper ) UL='L'; 101 else if ( Uplo == CblasLower ) UL='U'; 102 else 103 { 104 cblas_xerbla(3, "cblas_ctrmm", "Illegal Uplo setting, %d\n", Uplo); 105 CBLAS_CallFromC = 0; 106 RowMajorStrg = 0; 107 return; 108 } 109 110 if( TransA == CblasTrans ) TA ='T'; 111 else if ( TransA == CblasConjTrans ) TA='C'; 112 else if ( TransA == CblasNoTrans ) TA='N'; 113 else 114 { 115 cblas_xerbla(4, "cblas_ctrmm", "Illegal Trans setting, %d\n", TransA); 116 CBLAS_CallFromC = 0; 117 RowMajorStrg = 0; 118 return; 119 } 120 121 if( Diag == CblasUnit ) DI='U'; 122 else if ( Diag == CblasNonUnit ) DI='N'; 123 else 124 { 125 cblas_xerbla(5, "cblas_ctrmm", "Illegal Diag setting, %d\n", Diag); 126 CBLAS_CallFromC = 0; 127 RowMajorStrg = 0; 128 return; 129 } 130 131 #ifdef F77_CHAR 132 F77_UL = C2F_CHAR(&UL); 133 F77_TA = C2F_CHAR(&TA); 134 F77_SD = C2F_CHAR(&SD); 135 F77_DI = C2F_CHAR(&DI); 136 #endif 137 138 F77_ctrmm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, &F77_lda, B, &F77_ldb); 139 } 140 else cblas_xerbla(1, "cblas_ctrmm", "Illegal Order setting, %d\n", Order); 141 CBLAS_CallFromC = 0; 142 RowMajorStrg = 0; 143 return; 144 } 145