1/*
2 * cblas_ctpsv.c
3 * The program is a C interface to ctpsv.
4 *
5 * Keita Teranishi  3/23/98
6 *
7 */
8#include "cblas.h"
9#include "cblas_f77.h"
10void cblas_ctpsv(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_ctpsv","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_ctpsv","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_ctpsv","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_ctpsv( 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_ctpsv","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
99            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