Home | History | Annotate | Download | only in src 
      1 /*
      2  * cblas_ctbsv.c
      3  * The program is a C interface to ctbsv.
      4  *
      5  * Keita Teranishi  3/23/98
      6  *
      7  */
      8 #include "cblas.h"
      9 #include "cblas_f77.h"
     10 void cblas_ctbsv(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 int K, const void  *A, const int lda,
     13                  void  *X, const int incX)
     14 {
     15    char TA;
     16    char UL;
     17    char DI;
     18 #ifdef F77_CHAR
     19    F77_CHAR F77_TA, F77_UL, F77_DI;
     20 #else
     21    #define F77_TA &TA
     22    #define F77_UL &UL
     23    #define F77_DI &DI
     24 #endif
     25 #ifdef F77_INT
     26    F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
     27 #else
     28    #define F77_N N
     29    #define F77_K K
     30    #define F77_lda lda
     31    #define F77_incX incX
     32 #endif
     33    int n, i=0, tincX;
     34    float *st=0,*x=(float *)X;
     35    extern int CBLAS_CallFromC;
     36    extern int RowMajorStrg;
     37    RowMajorStrg = 0;
     38 
     39    CBLAS_CallFromC = 1;
     40    if (order == CblasColMajor)
     41    {
     42       if (Uplo == CblasUpper) UL = 'U';
     43       else if (Uplo == CblasLower) UL = 'L';
     44       else
     45       {
     46          cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo);
     47          CBLAS_CallFromC = 0;
     48          RowMajorStrg = 0;
     49          return;
     50       }
     51       if (TransA == CblasNoTrans) TA = 'N';
     52       else if (TransA == CblasTrans) TA = 'T';
     53       else if (TransA == CblasConjTrans) TA = 'C';
     54       else
     55       {
     56          cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA);
     57          CBLAS_CallFromC = 0;
     58          RowMajorStrg = 0;
     59          return;
     60       }
     61       if (Diag == CblasUnit) DI = 'U';
     62       else if (Diag == CblasNonUnit) DI = 'N';
     63       else
     64       {
     65          cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag);
     66          CBLAS_CallFromC = 0;
     67          RowMajorStrg = 0;
     68          return;
     69       }
     70       #ifdef F77_CHAR
     71          F77_UL = C2F_CHAR(&UL);
     72          F77_TA = C2F_CHAR(&TA);
     73          F77_DI = C2F_CHAR(&DI);
     74       #endif
     75       F77_ctbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
     76                       &F77_incX);
     77    }
     78    else if (order == CblasRowMajor)
     79    {
     80       RowMajorStrg = 1;
     81       if (Uplo == CblasUpper) UL = 'L';
     82       else if (Uplo == CblasLower) UL = 'U';
     83       else
     84       {
     85          cblas_xerbla(2, "cblas_ctbsv","Illegal Uplo setting, %d\n", Uplo);
     86          CBLAS_CallFromC = 0;
     87          RowMajorStrg = 0;
     88          return;
     89       }
     90 
     91       if (TransA == CblasNoTrans) TA = 'T';
     92       else if (TransA == CblasTrans) TA = 'N';
     93       else if (TransA == CblasConjTrans)
     94       {
     95          TA = 'N';
     96          if ( N > 0)
     97          {
     98             if ( incX > 0 )
     99                tincX = incX;
    100             else
    101                tincX = -incX;
    102 
    103             n = N*2*(tincX);
    104 
    105             x++;
    106 
    107             st=x+n;
    108 
    109             i = tincX << 1;
    110             do
    111             {
    112                *x = -(*x);
    113                x+=i;
    114             }
    115             while (x != st);
    116             x -= n;
    117          }
    118       }
    119       else
    120       {
    121          cblas_xerbla(3, "cblas_ctbsv","Illegal TransA setting, %d\n", TransA);
    122          CBLAS_CallFromC = 0;
    123          RowMajorStrg = 0;
    124          return;
    125       }
    126 
    127       if (Diag == CblasUnit) DI = 'U';
    128       else if (Diag == CblasNonUnit) DI = 'N';
    129       else
    130       {
    131          cblas_xerbla(4, "cblas_ctbsv","Illegal Diag setting, %d\n", Diag);
    132          CBLAS_CallFromC = 0;
    133          RowMajorStrg = 0;
    134          return;
    135       }
    136       #ifdef F77_CHAR
    137          F77_UL = C2F_CHAR(&UL);
    138          F77_TA = C2F_CHAR(&TA);
    139          F77_DI = C2F_CHAR(&DI);
    140       #endif
    141 
    142       F77_ctbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
    143                       &F77_incX);
    144 
    145       if (TransA == CblasConjTrans)
    146       {
    147          if (N > 0)
    148          {
    149             do
    150             {
    151                *x = -(*x);
    152                x+= i;
    153             }
    154             while (x != st);
    155          }
    156       }
    157    }
    158    else cblas_xerbla(1, "cblas_ctbsv", "Illegal Order setting, %d\n", order);
    159    CBLAS_CallFromC = 0;
    160    RowMajorStrg = 0;
    161    return;
    162 }
    163