Home | History | Annotate | Download | only in src 
      1 /*
      2  * cblas_ztpsv.c
      3  * The program is a C interface to ztpsv.
      4  *
      5  * Keita Teranishi  3/23/98
      6  *
      7  */
      8 #include "cblas.h"
      9 #include "cblas_f77.h"
     10 void cblas_ztpsv(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    double *st=0, *x=(double*)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_ztpsv","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_ztpsv","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_ztpsv","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_ztpsv( 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_ztpsv","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_ztpsv","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_ztpsv","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_ztpsv( 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_ztpsv", "Illegal Order setting, %d\n", order);
    154    CBLAS_CallFromC = 0;
    155    RowMajorStrg = 0;
    156    return;
    157 }
    158