cblas_ctpsv.c
Go to the documentation of this file.
00001 /*
00002  * cblas_ctpsv.c
00003  * The program is a C interface to ctpsv.
00004  * 
00005  * Keita Teranishi  3/23/98
00006  *
00007  */
00008 #include "cblas.h"
00009 #include "cblas_f77.h"
00010 void cblas_ctpsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
00011                  const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
00012                  const int N, const void  *Ap, void  *X, const int incX)
00013 {
00014    char TA;
00015    char UL;
00016    char DI;
00017 #ifdef F77_CHAR
00018    F77_CHAR F77_TA, F77_UL, F77_DI;
00019 #else
00020    #define F77_TA &TA
00021    #define F77_UL &UL
00022    #define F77_DI &DI   
00023 #endif
00024 #ifdef F77_INT
00025    F77_INT F77_N=N, F77_incX=incX;
00026 #else
00027    #define F77_N N
00028    #define F77_incX incX
00029 #endif
00030    int n, i=0, tincX; 
00031    float *st=0, *x=(float*)X;
00032    extern int CBLAS_CallFromC;
00033    extern int RowMajorStrg;
00034    RowMajorStrg = 0;
00035 
00036    CBLAS_CallFromC = 1;
00037    if (order == CblasColMajor)
00038    {
00039       if (Uplo == CblasUpper) UL = 'U';
00040       else if (Uplo == CblasLower) UL = 'L';
00041       else 
00042       {
00043          cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
00044          CBLAS_CallFromC = 0;
00045          RowMajorStrg = 0;
00046          return;
00047       }
00048       if (TransA == CblasNoTrans) TA = 'N';
00049       else if (TransA == CblasTrans) TA = 'T';
00050       else if (TransA == CblasConjTrans) TA = 'C';
00051       else 
00052       {
00053          cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
00054          CBLAS_CallFromC = 0;
00055          RowMajorStrg = 0;
00056          return;
00057       }
00058       if (Diag == CblasUnit) DI = 'U';
00059       else if (Diag == CblasNonUnit) DI = 'N';
00060       else 
00061       {
00062          cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
00063          CBLAS_CallFromC = 0;
00064          RowMajorStrg = 0;
00065          return;
00066       }
00067       #ifdef F77_CHAR
00068          F77_UL = C2F_CHAR(&UL);
00069          F77_TA = C2F_CHAR(&TA);
00070          F77_DI = C2F_CHAR(&DI);
00071       #endif
00072       F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
00073    }
00074    else if (order == CblasRowMajor)
00075    {
00076       RowMajorStrg = 1;
00077       if (Uplo == CblasUpper) UL = 'L';
00078       else if (Uplo == CblasLower) UL = 'U';
00079       else 
00080       {
00081          cblas_xerbla(2, "cblas_ctpsv","Illegal Uplo setting, %d\n", Uplo);
00082          CBLAS_CallFromC = 0;
00083          RowMajorStrg = 0;
00084          return;
00085       }
00086 
00087       if (TransA == CblasNoTrans) TA = 'T';
00088       else if (TransA == CblasTrans) TA = 'N';
00089       else if (TransA == CblasConjTrans)
00090       {
00091          TA = 'N';
00092          if ( N > 0)
00093          {
00094             if ( incX > 0 )
00095                tincX = incX;
00096             else
00097                tincX = -incX;
00098  
00099             n = N*2*(tincX);
00100  
00101             x++;
00102 
00103             st=x+n;
00104 
00105             i = tincX << 1;
00106             do
00107             {
00108                *x = -(*x);
00109                x+=i;
00110             }
00111             while (x != st);
00112             x -= n;
00113          }
00114       }
00115       else 
00116       {
00117          cblas_xerbla(3, "cblas_ctpsv","Illegal TransA setting, %d\n", TransA);
00118          CBLAS_CallFromC = 0;
00119          RowMajorStrg = 0;
00120          return;
00121       }
00122 
00123       if (Diag == CblasUnit) DI = 'U';
00124       else if (Diag == CblasNonUnit) DI = 'N';
00125       else 
00126       {
00127          cblas_xerbla(4, "cblas_ctpsv","Illegal Diag setting, %d\n", Diag);
00128          CBLAS_CallFromC = 0;
00129          RowMajorStrg = 0;
00130          return;
00131       }
00132       #ifdef F77_CHAR
00133          F77_UL = C2F_CHAR(&UL);
00134          F77_TA = C2F_CHAR(&TA);
00135          F77_DI = C2F_CHAR(&DI);
00136       #endif
00137 
00138       F77_ctpsv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
00139 
00140       if (TransA == CblasConjTrans)
00141       {
00142          if (N > 0)
00143          {
00144             do
00145             {
00146                *x = -(*x);
00147                x += i;
00148             }
00149             while (x != st);
00150          }
00151       }
00152    }
00153    else cblas_xerbla(1, "cblas_ctpsv", "Illegal Order setting, %d\n", order);
00154    CBLAS_CallFromC = 0;
00155    RowMajorStrg = 0;
00156    return;
00157 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:15