001: /*
002:  * cblas_ctpsv.c
003:  * The program is a C interface to ctpsv.
004:  *
005:  * Keita Teranishi  3/23/98
006:  *
007:  */
008: #include "cblas.h"
009: #include "cblas_f77.h"
010: void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
011:                  const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
012:                  const int N, const void  *Ap, void  *X, const int incX)
013: {
014:    char TA;
015:    char UL;
016:    char DI;
017: #ifdef F77_CHAR
018:    F77_CHAR F77_TA, F77_UL, F77_DI;
019: #else
020:    #define F77_TA &TA
021:    #define F77_UL &UL
022:    #define F77_DI &DI
023: #endif
024: #ifdef F77_INT
025:    F77_INT F77_N=N, F77_incX=incX;
026: #else
027:    #define F77_N N
028:    #define F77_incX incX
029: #endif
030:    int n, i=0, tincX;
031:    float *st=0, *x=(float*)X;
032:    extern int CBLAS_CallFromC;
033:    extern int RowMajorStrg;
034:    RowMajorStrg = 0;
035: 
036:    CBLAS_CallFromC = 1;
037:    if (order == CblasColMajor)
038:    {
039:       if (Uplo == CblasUpper) UL = 'U';
040:       else if (Uplo == CblasLower) UL = 'L';
041:       else
042:       {
043:          cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
044:          CBLAS_CallFromC = 0;
045:          RowMajorStrg = 0;
046:          return;
047:       }
048:       if (TransA == CblasNoTrans) TA = 'N';
049:       else if (TransA == CblasTrans) TA = 'T';
050:       else if (TransA == CblasConjTrans) TA = 'C';
051:       else
052:       {
053:          cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
054:          CBLAS_CallFromC = 0;
055:          RowMajorStrg = 0;
056:          return;
057:       }
058:       if (Diag == CblasUnit) DI = 'U';
059:       else if (Diag == CblasNonUnit) DI = 'N';
060:       else
061:       {
062:          cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
063:          CBLAS_CallFromC = 0;
064:          RowMajorStrg = 0;
065:          return;
066:       }
067:       #ifdef F77_CHAR
068:          F77_UL = C2F_CHAR(&UL);
069:          F77_TA = C2F_CHAR(&TA);
070:          F77_DI = C2F_CHAR(&DI);
071:       #endif
072:       F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
073:    }
074:    else if (order == CblasRowMajor)
075:    {
076:       RowMajorStrg = 1;
077:       if (Uplo == CblasUpper) UL = 'L';
078:       else if (Uplo == CblasLower) UL = 'U';
079:       else
080:       {
081:          cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
082:          CBLAS_CallFromC = 0;
083:          RowMajorStrg = 0;
084:          return;
085:       }
086: 
087:       if (TransA == CblasNoTrans) TA = 'T';
088:       else if (TransA == CblasTrans) TA = 'N';
089:       else if (TransA == CblasConjTrans)
090:       {
091:          TA = 'N';
092:          if ( N > 0)
093:          {
094:             if ( incX > 0 )
095:                tincX = incX;
096:             else
097:                tincX = -incX;
098: 
099:             n = N*2*(tincX);
100: 
101:             x++;
102: 
103:             st=x+n;
104: 
105:             i = tincX << 1;
106:             do
107:             {
108:                *x = -(*x);
109:                x+=i;
110:             }
111:             while (x != st);
112:             x -= n;
113:          }
114:       }
115:       else
116:       {
117:          cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
118:          CBLAS_CallFromC = 0;
119:          RowMajorStrg = 0;
120:          return;
121:       }
122: 
123:       if (Diag == CblasUnit) DI = 'U';
124:       else if (Diag == CblasNonUnit) DI = 'N';
125:       else
126:       {
127:          cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
128:          CBLAS_CallFromC = 0;
129:          RowMajorStrg = 0;
130:          return;
131:       }
132:       #ifdef F77_CHAR
133:          F77_UL = C2F_CHAR(&UL);
134:          F77_TA = C2F_CHAR(&TA);
135:          F77_DI = C2F_CHAR(&DI);
136:       #endif
137: 
138:       F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
139: 
140:       if (TransA == CblasConjTrans)
141:       {
142:          if (N > 0)
143:          {
144:             do
145:             {
146:                *x = -(*x);
147:                x += i;
148:             }
149:             while (x != st);
150:          }
151:       }
152:    }
153:    else cblas_xerbla(1, "cblas_ctpsv", "Illegal Order setting, %d\n", order);
154:    CBLAS_CallFromC = 0;
155:    RowMajorStrg = 0;
156:    return;
157: }
158: