cblas_stbsv.c
Go to the documentation of this file.
00001 /*
00002  * cblas_stbsv.c
00003  * The program is a C interface to stbsv.
00004  *
00005  * Keita Teranishi  5/20/98
00006  *
00007  */
00008 #include "cblas.h"
00009 #include "cblas_f77.h"
00010 void cblas_stbsv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
00011                  const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
00012                  const int N, const int K, const float  *A, const int lda,
00013                  float  *X, const int incX)
00014 {
00015    char TA;
00016    char UL;
00017    char DI;
00018 #ifdef F77_CHAR
00019    F77_CHAR F77_TA, F77_UL, F77_DI;
00020 #else
00021    #define F77_TA &TA
00022    #define F77_UL &UL
00023    #define F77_DI &DI   
00024 #endif
00025 #ifdef F77_INT
00026    F77_INT F77_N=N, F77_lda=lda, F77_K=K, F77_incX=incX;
00027 #else
00028    #define F77_N N
00029    #define F77_K K
00030    #define F77_lda lda
00031    #define F77_incX incX
00032 #endif
00033    extern int CBLAS_CallFromC;
00034    extern int RowMajorStrg;
00035    RowMajorStrg = 0;
00036 
00037    CBLAS_CallFromC = 1;
00038    if (order == CblasColMajor)
00039    {
00040       if (Uplo == CblasUpper) UL  = 'U';
00041       else if (Uplo == CblasLower) UL = 'L';
00042       else 
00043       {
00044          cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
00045          CBLAS_CallFromC = 0;
00046          RowMajorStrg = 0;
00047          return;
00048       }
00049       if (TransA == CblasNoTrans) TA = 'N';
00050       else if (TransA == CblasTrans) TA = 'T';
00051       else if (TransA == CblasConjTrans) TA = 'C';
00052       else 
00053       {
00054          cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
00055          CBLAS_CallFromC = 0;
00056          RowMajorStrg = 0;
00057          return;
00058       }
00059       if (Diag == CblasUnit) DI = 'U';
00060       else if (Diag == CblasNonUnit) DI = 'N';
00061       else 
00062       {
00063          cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
00064          CBLAS_CallFromC = 0;
00065          RowMajorStrg = 0;
00066          return;
00067       }
00068       #ifdef F77_CHAR
00069          F77_UL = C2F_CHAR(&UL);
00070          F77_TA = C2F_CHAR(&TA);
00071          F77_DI = C2F_CHAR(&DI);
00072       #endif
00073       F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
00074                       &F77_incX);
00075    }
00076    else if (order == CblasRowMajor)
00077    {
00078       RowMajorStrg = 1;
00079       if (Uplo == CblasUpper) UL = 'L';
00080       else if (Uplo == CblasLower) UL = 'U';
00081       else 
00082       {
00083          cblas_xerbla(2, "cblas_stbsv","Illegal Uplo setting, %d\n", Uplo);
00084          CBLAS_CallFromC = 0;
00085          RowMajorStrg = 0;
00086          return;
00087       }
00088 
00089       if (TransA == CblasNoTrans) TA = 'T';
00090       else if (TransA == CblasTrans) TA = 'N';
00091       else if (TransA == CblasConjTrans) TA = 'N';
00092       else 
00093       {
00094          cblas_xerbla(3, "cblas_stbsv","Illegal TransA setting, %d\n", TransA);
00095          CBLAS_CallFromC = 0;
00096          RowMajorStrg = 0;
00097          return;
00098       }
00099 
00100       if (Diag == CblasUnit) DI = 'U';
00101       else if (Diag == CblasNonUnit) DI = 'N';
00102       else 
00103       {
00104          cblas_xerbla(4, "cblas_stbsv","Illegal Diag setting, %d\n", Diag);
00105          CBLAS_CallFromC = 0;
00106          RowMajorStrg = 0;
00107          return;
00108       }
00109       #ifdef F77_CHAR
00110          F77_UL = C2F_CHAR(&UL);
00111          F77_TA = C2F_CHAR(&TA);
00112          F77_DI = C2F_CHAR(&DI);
00113       #endif
00114 
00115       F77_stbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
00116                       &F77_incX);
00117    }
00118    else cblas_xerbla(1, "cblas_stbsv", "Illegal Order setting, %d\n", order);
00119    CBLAS_CallFromC = 0;
00120    RowMajorStrg = 0;
00121    return;
00122 }


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:16