Home | History | Annotate | Download | only in src 
      1 /*
      2  * cblas_ztpmv.c
      3  * The program is a C interface to ztpmv.
      4  *
      5  * Keita Teranishi  5/20/98
      6  *
      7  */
      8 #include "cblas.h"
      9 #include "cblas_f77.h"
     10 void cblas_ztpmv(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_ztpmv","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_ztpmv","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_ztpmv","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_ztpmv( 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_ztpmv","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_ztpmv","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_ztpmv","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_ztpmv( 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_ztpmv", "Illegal Order setting, %d\n", order);
    149    CBLAS_CallFromC = 0;
    150    RowMajorStrg = 0;
    151    return;
    152 }
    153