001: /*
002:  *
003:  * cblas_ctrsm.c
004:  * This program is a C interface to ctrsm.
005:  * Written by Keita Teranishi
006:  * 4/8/1998
007:  *
008:  */
009: 
010: #include "cblas.h"
011: #include "cblas_f77.h"
012: void cblas_ctrsm(const enum CBLAS_ORDER Order, const enum CBLAS_SIDE Side,
013:                  const enum CBLAS_UPLO Uplo, const enum CBLAS_TRANSPOSE TransA,
014:                  const enum CBLAS_DIAG Diag, const int M, const int N,
015:                  const void *alpha, const void  *A, const int lda,
016:                  void  *B, const int ldb)
017: {
018:    char UL, TA, SD, DI;
019: #ifdef F77_CHAR
020:    F77_CHAR F77_TA, F77_UL, F77_SD, F77_DI;
021: #else
022:    #define F77_TA &TA
023:    #define F77_UL &UL
024:    #define F77_SD &SD
025:    #define F77_DI &DI
026: #endif
027: 
028: #ifdef F77_INT
029:    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_ldb=ldb;
030: #else
031:    #define F77_M M
032:    #define F77_N N
033:    #define F77_lda lda
034:    #define F77_ldb ldb
035: #endif
036: 
037:    extern int CBLAS_CallFromC;
038:    extern int RowMajorStrg;
039:    RowMajorStrg = 0;
040:    CBLAS_CallFromC = 1;
041: 
042:    if( Order == CblasColMajor )
043:    {
044: 
045:       if( Side == CblasRight) SD='R';
046:       else if ( Side == CblasLeft ) SD='L';
047:       else
048:       {
049:          cblas_xerbla(2, "cblas_ctrsm", "Illegal Side setting, %d\n", Side);
050:          CBLAS_CallFromC = 0;
051:          RowMajorStrg = 0;
052:          return;
053:       }
054: 
055:       if( Uplo == CblasUpper) UL='U';
056:       else if ( Uplo == CblasLower ) UL='L';
057:       else
058:       {
059:          cblas_xerbla(3, "cblas_ctrsm", "Illegal Uplo setting, %d\n", Uplo);
060:          CBLAS_CallFromC = 0;
061:          RowMajorStrg = 0;
062:          return;
063:       }
064: 
065:       if( TransA == CblasTrans) TA ='T';
066:       else if ( TransA == CblasConjTrans ) TA='C';
067:       else if ( TransA == CblasNoTrans )   TA='N';
068:       else
069:       {
070:          cblas_xerbla(4, "cblas_ctrsm", "Illegal Trans setting, %d\n", TransA);
071:          CBLAS_CallFromC = 0;
072:          RowMajorStrg = 0;
073:          return;
074:       }
075: 
076:       if( Diag == CblasUnit ) DI='U';
077:       else if ( Diag == CblasNonUnit ) DI='N';
078:       else
079:       {
080:          cblas_xerbla(5, "cblas_ctrsm", "Illegal Diag setting, %d\n", Diag);
081:          CBLAS_CallFromC = 0;
082:          RowMajorStrg = 0;
083:          return;
084:       }
085: 
086:       #ifdef F77_CHAR
087:          F77_UL = C2F_CHAR(&UL);
088:          F77_TA = C2F_CHAR(&TA);
089:          F77_SD = C2F_CHAR(&SD);
090:          F77_DI = C2F_CHAR(&DI);
091:       #endif
092: 
093:       F77_ctrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_M, &F77_N, (const float *)alpha, (const float *)A,
094:                 &F77_lda, (float *)B, &F77_ldb);
095:    } else if (Order == CblasRowMajor)
096:    {
097:       RowMajorStrg = 1;
098: 
099:       if( Side == CblasRight) SD='L';
100:       else if ( Side == CblasLeft ) SD='R';
101:       else
102:       {
103:          cblas_xerbla(2, "cblas_ctrsm", "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_ctrsm", "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_ctrsm", "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_ctrsm", "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_ctrsm(F77_SD, F77_UL, F77_TA, F77_DI, &F77_N, &F77_M, (const float *)alpha, (const float *)A,
149:                 &F77_lda, (float *)B, &F77_ldb);
150:    }
151:    else cblas_xerbla(1, "cblas_ctrsm", "Illegal Order setting, %d\n", Order);
152:    CBLAS_CallFromC = 0;
153:    RowMajorStrg = 0;
154:    return;
155: }
156: