1/* 2 * 3 * cblas_ztrsm.c 4 * This program is a C interface to ztrsm. 5 * Written by Keita Teranishi 6 * 4/8/1998 7 * 8 */ 9 10#include "cblas.h" 11#include "cblas_f77.h" 12void cblas_ztrsm(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 45 if( Side == CblasRight) SD='R'; 46 else if ( Side == CblasLeft ) SD='L'; 47 else 48 { 49 cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side); 50 CBLAS_CallFromC = 0; 51 RowMajorStrg = 0; 52 return; 53 } 54 55 if( Uplo == CblasUpper) UL='U'; 56 else if ( Uplo == CblasLower ) UL='L'; 57 else 58 { 59 cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo); 60 CBLAS_CallFromC = 0; 61 RowMajorStrg = 0; 62 return; 63 } 64 65 if( TransA == CblasTrans) TA ='T'; 66 else if ( TransA == CblasConjTrans ) TA='C'; 67 else if ( TransA == CblasNoTrans ) TA='N'; 68 else 69 { 70 cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA); 71 CBLAS_CallFromC = 0; 72 RowMajorStrg = 0; 73 return; 74 } 75 76 if( Diag == CblasUnit ) DI='U'; 77 else if ( Diag == CblasNonUnit ) DI='N'; 78 else 79 { 80 cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag); 81 CBLAS_CallFromC = 0; 82 RowMajorStrg = 0; 83 return; 84 } 85 86 #ifdef F77_CHAR 87 F77_UL = C2F_CHAR(&UL); 88 F77_TA = C2F_CHAR(&TA); 89 F77_SD = C2F_CHAR(&SD); 90 F77_DI = C2F_CHAR(&DI); 91 #endif 92 93 F77_ztrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, alpha, A, 94 &F77_lda, B, &F77_ldb); 95 } else if (Order == CblasRowMajor) 96 { 97 RowMajorStrg = 1; 98 99 if( Side == CblasRight) SD='L'; 100 else if ( Side == CblasLeft ) SD='R'; 101 else 102 { 103 cblas_xerbla(2, "cblas_ztrsm", "Illegal Side setting, %d\n", Side); 104 CBLAS_CallFromC = 0; 105 RowMajorStrg = 0; 106 return; 107 } 108 109 if( Uplo == CblasUpper) UL='L'; 110 else if ( Uplo == CblasLower ) UL='U'; 111 else 112 { 113 cblas_xerbla(3, "cblas_ztrsm", "Illegal Uplo setting, %d\n", Uplo); 114 CBLAS_CallFromC = 0; 115 RowMajorStrg = 0; 116 return; 117 } 118 119 if( TransA == CblasTrans) TA ='T'; 120 else if ( TransA == CblasConjTrans ) TA='C'; 121 else if ( TransA == CblasNoTrans ) TA='N'; 122 else 123 { 124 cblas_xerbla(4, "cblas_ztrsm", "Illegal Trans setting, %d\n", TransA); 125 CBLAS_CallFromC = 0; 126 RowMajorStrg = 0; 127 return; 128 } 129 130 if( Diag == CblasUnit ) DI='U'; 131 else if ( Diag == CblasNonUnit ) DI='N'; 132 else 133 { 134 cblas_xerbla(5, "cblas_ztrsm", "Illegal Diag setting, %d\n", Diag); 135 CBLAS_CallFromC = 0; 136 RowMajorStrg = 0; 137 return; 138 } 139 140 #ifdef F77_CHAR 141 F77_UL = C2F_CHAR(&UL); 142 F77_TA = C2F_CHAR(&TA); 143 F77_SD = C2F_CHAR(&SD); 144 F77_DI = C2F_CHAR(&DI); 145 #endif 146 147 148 F77_ztrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, alpha, A, 149 &F77_lda, B, &F77_ldb); 150 } 151 else cblas_xerbla(1, "cblas_ztrsm", "Illegal Order setting, %d\n", Order); 152 CBLAS_CallFromC = 0; 153 RowMajorStrg = 0; 154 return; 155} 156