cblas_ztbsv.c
Go to the documentation of this file.
00001 /*
00002  * cblas_ztbsv.c
00003  * The program is a C interface to ztbsv.
00004  * 
00005  * Keita Teranishi  3/23/98
00006  *
00007  */
00008 #include "cblas.h"
00009 #include "cblas_f77.h"
00010 void cblas_ztbsv(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 void  *A, const int lda,
00013                  void  *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    int n, i=0, tincX; 
00034    double *st=0,*x=(double *)X;
00035    extern int CBLAS_CallFromC;
00036    extern int RowMajorStrg;
00037    RowMajorStrg = 0;
00038 
00039    CBLAS_CallFromC = 1;
00040    if (order == CblasColMajor)
00041    {
00042       if (Uplo == CblasUpper) UL = 'U';
00043       else if (Uplo == CblasLower) UL = 'L';
00044       else 
00045       {
00046          cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo);
00047          CBLAS_CallFromC = 0;
00048          RowMajorStrg = 0;
00049          return;
00050       }
00051       if (TransA == CblasNoTrans) TA = 'N';
00052       else if (TransA == CblasTrans) TA = 'T';
00053       else if (TransA == CblasConjTrans) TA = 'C';
00054       else 
00055       {
00056          cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA);
00057          CBLAS_CallFromC = 0;
00058          RowMajorStrg = 0;
00059          return;
00060       }
00061       if (Diag == CblasUnit) DI = 'U';
00062       else if (Diag == CblasNonUnit) DI = 'N';
00063       else 
00064       {
00065          cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag);
00066          CBLAS_CallFromC = 0;
00067          RowMajorStrg = 0;
00068          return;
00069       }
00070       #ifdef F77_CHAR
00071          F77_UL = C2F_CHAR(&UL);
00072          F77_TA = C2F_CHAR(&TA);
00073          F77_DI = C2F_CHAR(&DI);
00074       #endif
00075       F77_ztbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
00076                       &F77_incX);
00077    }
00078    else if (order == CblasRowMajor)
00079    {
00080       RowMajorStrg = 1;
00081       if (Uplo == CblasUpper) UL = 'L';
00082       else if (Uplo == CblasLower) UL = 'U';
00083       else 
00084       {
00085          cblas_xerbla(2, "cblas_ztbsv","Illegal Uplo setting, %d\n", Uplo);
00086          CBLAS_CallFromC = 0;
00087          RowMajorStrg = 0;
00088          return;
00089       }
00090 
00091       if (TransA == CblasNoTrans) TA = 'T';
00092       else if (TransA == CblasTrans) TA = 'N';
00093       else if (TransA == CblasConjTrans)
00094       {
00095          TA = 'N';
00096          if ( N > 0)
00097          {
00098             if ( incX > 0 )
00099                tincX = incX;
00100             else
00101                tincX = -incX;
00102  
00103             n = N*2*(tincX);
00104   
00105             x++;
00106 
00107             st=x+n;
00108 
00109             i = tincX << 1;
00110             do
00111             {
00112                *x = -(*x);
00113                x+=i;
00114             }
00115             while (x != st);
00116             x -= n;
00117          }
00118       }
00119       else 
00120       {
00121          cblas_xerbla(3, "cblas_ztbsv","Illegal TransA setting, %d\n", TransA);
00122          CBLAS_CallFromC = 0;
00123          RowMajorStrg = 0;
00124          return;
00125       }
00126 
00127       if (Diag == CblasUnit) DI = 'U';
00128       else if (Diag == CblasNonUnit) DI = 'N';
00129       else 
00130       {
00131          cblas_xerbla(4, "cblas_ztbsv","Illegal Diag setting, %d\n", Diag);
00132          CBLAS_CallFromC = 0;
00133          RowMajorStrg = 0;
00134          return;
00135       }
00136       #ifdef F77_CHAR
00137          F77_UL = C2F_CHAR(&UL);
00138          F77_TA = C2F_CHAR(&TA);
00139          F77_DI = C2F_CHAR(&DI);
00140       #endif
00141 
00142       F77_ztbsv( F77_UL, F77_TA, F77_DI, &F77_N, &F77_K, A, &F77_lda, X,
00143                       &F77_incX);
00144 
00145       if (TransA == CblasConjTrans)
00146       {
00147          if (N > 0)
00148          {
00149             do
00150             {
00151                *x = -(*x);
00152                x+= i;
00153             }
00154             while (x != st);
00155          }
00156       }
00157    }
00158    else cblas_xerbla(1, "cblas_ztbsv", "Illegal Order setting, %d\n", order);
00159    CBLAS_CallFromC = 0;
00160    RowMajorStrg = 0;
00161    return;
00162 }


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