001: /*
002:  * cblas_ctpmv.c
003:  * The program is a C interface to ctpmv.
004:  *
005:  * Keita Teranishi  5/20/98
006:  *
007:  */
008: #include "cblas.h"
009: #include "cblas_f77.h"
010: void cblas_ctpmv(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_ctpmv","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_ctpmv","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_ctpmv","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_ctpmv( 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_ctpmv","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:             i = tincX << 1;
099:             n = i * N;
100:             x++;
101:             st = x + n;
102:             do
103:             {
104:                *x = -(*x);
105:                x += i;
106:             }
107:             while (x != st);
108:             x -= n;
109:          }
110:       }
111:       else
112:       {
113:          cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA);
114:          CBLAS_CallFromC = 0;
115:          RowMajorStrg = 0;
116:          return;
117:       }
118: 
119:       if (Diag == CblasUnit) DI = 'U';
120:       else if (Diag == CblasNonUnit) DI = 'N';
121:       else
122:       {
123:          cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag);
124:          CBLAS_CallFromC = 0;
125:          RowMajorStrg = 0;
126:          return;
127:       }
128:       #ifdef F77_CHAR
129:          F77_UL = C2F_CHAR(&UL);
130:          F77_TA = C2F_CHAR(&TA);
131:          F77_DI = C2F_CHAR(&DI);
132:       #endif
133: 
134:       F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
135:       if (TransA == CblasConjTrans)
136:       {
137:          if (N > 0)
138:          {
139:             do
140:             {
141:                *x = -(*x);
142:                x += i;
143:             }
144:             while (x != st);
145:          }
146:       }
147:    }
148:    else cblas_xerbla(1, "cblas_ctpmv", "Illegal Order setting, %d\n", order);
149:    CBLAS_CallFromC = 0;
150:    RowMajorStrg = 0;
151:    return;
152: }
153: