Home | History | Annotate | Download | only in src 
      1 /*
      2  * cblas_ztrsv.c
      3  * The program is a C interface to ztrsv.
      4  *
      5  * Keita Teranishi  3/23/98
      6  *
      7  */
      8 #include "cblas.h"
      9 #include "cblas_f77.h"
     10 void cblas_ztrsv(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  *A, const int lda, void  *X,
     13                  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_incX=incX;
     27 #else
     28    #define F77_N N
     29    #define F77_lda lda
     30    #define F77_incX incX
     31 #endif
     32    int n, i=0, tincX;
     33    double *st=0,*x=(double *)X;
     34    extern int CBLAS_CallFromC;
     35    extern int RowMajorStrg;
     36    RowMajorStrg = 0;
     37 
     38    CBLAS_CallFromC = 1;
     39    if (order == CblasColMajor)
     40    {
     41       if (Uplo == CblasUpper) UL = 'U';
     42       else if (Uplo == CblasLower) UL = 'L';
     43       else
     44       {
     45          cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo);
     46          CBLAS_CallFromC = 0;
     47          RowMajorStrg = 0;
     48          return;
     49       }
     50       if (TransA == CblasNoTrans) TA = 'N';
     51       else if (TransA == CblasTrans) TA = 'T';
     52       else if (TransA == CblasConjTrans) TA = 'C';
     53       else
     54       {
     55          cblas_xerbla(3, "cblas_ztrsv","Illegal TransA setting, %d\n", TransA);
     56          CBLAS_CallFromC = 0;
     57          RowMajorStrg = 0;
     58          return;
     59       }
     60       if (Diag == CblasUnit) DI = 'U';
     61       else if (Diag == CblasNonUnit) DI = 'N';
     62       else
     63       {
     64          cblas_xerbla(4, "cblas_ztrsv","Illegal Diag setting, %d\n", Diag);
     65          CBLAS_CallFromC = 0;
     66          RowMajorStrg = 0;
     67          return;
     68       }
     69       #ifdef F77_CHAR
     70          F77_UL = C2F_CHAR(&UL);
     71          F77_TA = C2F_CHAR(&TA);
     72          F77_DI = C2F_CHAR(&DI);
     73       #endif
     74       F77_ztrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
     75                       &F77_incX);
     76    }
     77    else if (order == CblasRowMajor)
     78    {
     79       RowMajorStrg = 1;
     80       if (Uplo == CblasUpper) UL = 'L';
     81       else if (Uplo == CblasLower) UL = 'U';
     82       else
     83       {
     84          cblas_xerbla(2, "cblas_ztrsv","Illegal Uplo setting, %d\n", Uplo);
     85          CBLAS_CallFromC = 0;
     86          RowMajorStrg = 0;
     87          return;
     88       }
     89 
     90       if (TransA == CblasNoTrans) TA = 'T';
     91       else if (TransA == CblasTrans) TA = 'N';
     92       else if (TransA == CblasConjTrans)
     93       {
     94          TA = 'N';
     95          if ( N > 0)
     96          {
     97             if ( incX > 0 )
     98                tincX = incX;
     99             else
    100                tincX = -incX;
    101 
    102             n = N*2*(tincX);
    103             x++;
    104             st=x+n;
    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_ztrsv","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_ztrsv","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       F77_ztrsv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
    138                       &F77_incX);
    139       if (TransA == CblasConjTrans)
    140       {
    141          if (N > 0)
    142          {
    143             do
    144             {
    145                *x = -(*x);
    146                x += i;
    147             }
    148             while (x != st);
    149          }
    150       }
    151    }
    152    else cblas_xerbla(1, "cblas_ztrsv", "Illegal Order setting, %d\n", order);
    153    CBLAS_CallFromC = 0;
    154    RowMajorStrg = 0;
    155    return;
    156 }
    157