Home | History | Annotate | Download | only in src
      1 /*
      2  *
      3  * cblas_stpmv.c
      4  * This program is a C interface to stpmv.
      5  * Written by Keita Teranishi
      6  * 4/6/1998
      7  *
      8  */
      9 #include "cblas.h"
     10 #include "cblas_f77.h"
     11 void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
     12                  const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
     13                  const int N, const float  *Ap, float  *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_incX=incX;
     27 #else
     28    #define F77_N N
     29    #define F77_incX incX
     30 #endif
     31    extern int CBLAS_CallFromC;
     32    extern int RowMajorStrg;
     33    RowMajorStrg = 0;
     34 
     35    CBLAS_CallFromC = 1;
     36    if (order == CblasColMajor)
     37    {
     38       if (Uplo == CblasUpper) UL = 'U';
     39       else if (Uplo == CblasLower) UL = 'L';
     40       else
     41       {
     42          cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
     43          CBLAS_CallFromC = 0;
     44          RowMajorStrg = 0;
     45          return;
     46       }
     47       if (TransA == CblasNoTrans) TA = 'N';
     48       else if (TransA == CblasTrans) TA = 'T';
     49       else if (TransA == CblasConjTrans) TA = 'C';
     50       else
     51       {
     52          cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
     53          CBLAS_CallFromC = 0;
     54          RowMajorStrg = 0;
     55          return;
     56       }
     57       if (Diag == CblasUnit) DI = 'U';
     58       else if (Diag == CblasNonUnit) DI = 'N';
     59       else
     60       {
     61          cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
     62          CBLAS_CallFromC = 0;
     63          RowMajorStrg = 0;
     64          return;
     65       }
     66       #ifdef F77_CHAR
     67          F77_UL = C2F_CHAR(&UL);
     68          F77_TA = C2F_CHAR(&TA);
     69          F77_DI = C2F_CHAR(&DI);
     70       #endif
     71       F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
     72    }
     73    else if (order == CblasRowMajor)
     74    {
     75       RowMajorStrg = 1;
     76       if (Uplo == CblasUpper) UL = 'L';
     77       else if (Uplo == CblasLower) UL = 'U';
     78       else
     79       {
     80          cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
     81          CBLAS_CallFromC = 0;
     82          RowMajorStrg = 0;
     83          return;
     84       }
     85 
     86       if (TransA == CblasNoTrans) TA = 'T';
     87       else if (TransA == CblasTrans) TA = 'N';
     88       else if (TransA == CblasConjTrans) TA = 'N';
     89       else
     90       {
     91          cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
     92          CBLAS_CallFromC = 0;
     93          RowMajorStrg = 0;
     94          return;
     95       }
     96 
     97       if (Diag == CblasUnit) DI = 'U';
     98       else if (Diag == CblasNonUnit) DI = 'N';
     99       else
    100       {
    101          cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
    102          CBLAS_CallFromC = 0;
    103          RowMajorStrg = 0;
    104          return;
    105       }
    106       #ifdef F77_CHAR
    107          F77_UL = C2F_CHAR(&UL);
    108          F77_TA = C2F_CHAR(&TA);
    109          F77_DI = C2F_CHAR(&DI);
    110       #endif
    111 
    112       F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X,&F77_incX);
    113    }
    114    else cblas_xerbla(1, "cblas_stpmv", "Illegal Order setting, %d\n", order);
    115    CBLAS_CallFromC = 0;
    116    RowMajorStrg = 0;
    117    return;
    118 }
    119