1/*
2 * cblas_ctpmv.c
3 * The program is a C interface to ctpmv.
4 *
5 * Keita Teranishi  5/20/98
6 *
7 */
8#include "cblas.h"
9#include "cblas_f77.h"
10void cblas_ctpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
11                 const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
12                 const int N, const void  *Ap, void  *X, const int incX)
13{
14   char TA;
15   char UL;
16   char DI;
17#ifdef F77_CHAR
18   F77_CHAR F77_TA, F77_UL, F77_DI;
19#else
20   #define F77_TA &TA
21   #define F77_UL &UL
22   #define F77_DI &DI
23#endif
24#ifdef F77_INT
25   F77_INT F77_N=N, F77_incX=incX;
26#else
27   #define F77_N N
28   #define F77_incX incX
29#endif
30   int n, i=0, tincX;
31   float *st=0,*x=(float *)X;
32   extern int CBLAS_CallFromC;
33   extern int RowMajorStrg;
34   RowMajorStrg = 0;
35
36   CBLAS_CallFromC = 1;
37   if (order == CblasColMajor)
38   {
39      if (Uplo == CblasUpper) UL = 'U';
40      else if (Uplo == CblasLower) UL = 'L';
41      else
42      {
43         cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo);
44         CBLAS_CallFromC = 0;
45         RowMajorStrg = 0;
46         return;
47      }
48      if (TransA == CblasNoTrans) TA = 'N';
49      else if (TransA == CblasTrans) TA = 'T';
50      else if (TransA == CblasConjTrans) TA = 'C';
51      else
52      {
53         cblas_xerbla(3, "cblas_ctpmv","Illegal TransA setting, %d\n", TransA);
54         CBLAS_CallFromC = 0;
55         RowMajorStrg = 0;
56         return;
57      }
58      if (Diag == CblasUnit) DI = 'U';
59      else if (Diag == CblasNonUnit) DI = 'N';
60      else
61      {
62         cblas_xerbla(4, "cblas_ctpmv","Illegal Diag setting, %d\n", Diag);
63         CBLAS_CallFromC = 0;
64         RowMajorStrg = 0;
65         return;
66      }
67      #ifdef F77_CHAR
68         F77_UL = C2F_CHAR(&UL);
69         F77_TA = C2F_CHAR(&TA);
70         F77_DI = C2F_CHAR(&DI);
71      #endif
72      F77_ctpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
73   }
74   else if (order == CblasRowMajor)
75   {
76      RowMajorStrg = 1;
77      if (Uplo == CblasUpper) UL = 'L';
78      else if (Uplo == CblasLower) UL = 'U';
79      else
80      {
81         cblas_xerbla(2, "cblas_ctpmv","Illegal Uplo setting, %d\n", Uplo);
82         CBLAS_CallFromC = 0;
83         RowMajorStrg = 0;
84         return;
85      }
86
87      if (TransA == CblasNoTrans) TA = 'T';
88      else if (TransA == CblasTrans) TA = 'N';
89      else if (TransA == CblasConjTrans)
90      {
91         TA = 'N';
92         if ( N > 0)
93         {
94            if(incX > 0)
95               tincX = incX;
96            else
97               tincX = -incX;
98            i = tincX << 1;
99            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