Home | History | Annotate | Download | only in src
      1 /*
      2  *
      3  * cblas_dtrmv.c
      4  * This program is a C interface to sgemv.
      5  * Written by Keita Teranishi
      6  * 4/6/1998
      7  *
      8  */
      9 
     10 #include "cblas.h"
     11 #include "cblas_f77.h"
     12 void cblas_dtrmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
     13                  const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
     14                  const int N, const double  *A, const int lda,
     15                  double  *X, const int incX)
     16 
     17 {
     18    char TA;
     19    char UL;
     20    char DI;
     21 #ifdef F77_CHAR
     22    F77_CHAR F77_TA, F77_UL, F77_DI;
     23 #else
     24    #define F77_TA &TA
     25    #define F77_UL &UL
     26    #define F77_DI &DI
     27 #endif
     28 #ifdef F77_INT
     29    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
     30 #else
     31    #define F77_N N
     32    #define F77_lda lda
     33    #define F77_incX incX
     34 #endif
     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_dtrmv","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_dtrmv","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_dtrmv","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_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, 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_dtrmv","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) TA = 'N';
     94       else
     95       {
     96          cblas_xerbla(3, "cblas_dtrmv","Illegal TransA setting, %d\n", TransA);
     97          CBLAS_CallFromC = 0;
     98          RowMajorStrg = 0;
     99          return;
    100       }
    101 
    102       if (Diag == CblasUnit) DI = 'U';
    103       else if (Diag == CblasNonUnit) DI = 'N';
    104       else
    105       {
    106          cblas_xerbla(4, "cblas_dtrmv","Illegal Diag setting, %d\n", Diag);
    107          CBLAS_CallFromC = 0;
    108          RowMajorStrg = 0;
    109          return;
    110       }
    111       #ifdef F77_CHAR
    112          F77_UL = C2F_CHAR(&UL);
    113          F77_TA = C2F_CHAR(&TA);
    114          F77_DI = C2F_CHAR(&DI);
    115       #endif
    116       F77_dtrmv( F77_UL, F77_TA, F77_DI, &F77_N, A, &F77_lda, X,
    117                       &F77_incX);
    118    } else cblas_xerbla(1, "cblas_dtrmv", "Illegal order setting, %d\n", order);
    119    CBLAS_CallFromC = 0;
    120    RowMajorStrg = 0;
    121    return;
    122 }
    123