001: /*
002:  *
003:  * cblas_stpmv.c
004:  * This program is a C interface to stpmv.
005:  * Written by Keita Teranishi
006:  * 4/6/1998
007:  *
008:  */
009: #include "cblas.h"
010: #include "cblas_f77.h"
011: void cblas_stpmv(const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
012:                  const enum CBLAS_TRANSPOSE TransA, const enum CBLAS_DIAG Diag,
013:                  const int N, const float  *Ap, float  *X, const int incX)
014: {
015:    char TA;
016:    char UL;
017:    char DI;
018: #ifdef F77_CHAR
019:    F77_CHAR F77_TA, F77_UL, F77_DI;
020: #else
021:    #define F77_TA &TA
022:    #define F77_UL &UL
023:    #define F77_DI &DI
024: #endif
025: #ifdef F77_INT
026:    F77_INT F77_N=N, F77_incX=incX;
027: #else
028:    #define F77_N N
029:    #define F77_incX incX
030: #endif
031:    extern int CBLAS_CallFromC;
032:    extern int RowMajorStrg;
033:    RowMajorStrg = 0;
034: 
035:    CBLAS_CallFromC = 1;
036:    if (order == CblasColMajor)
037:    {
038:       if (Uplo == CblasUpper) UL = 'U';
039:       else if (Uplo == CblasLower) UL = 'L';
040:       else
041:       {
042:          cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
043:          CBLAS_CallFromC = 0;
044:          RowMajorStrg = 0;
045:          return;
046:       }
047:       if (TransA == CblasNoTrans) TA = 'N';
048:       else if (TransA == CblasTrans) TA = 'T';
049:       else if (TransA == CblasConjTrans) TA = 'C';
050:       else
051:       {
052:          cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
053:          CBLAS_CallFromC = 0;
054:          RowMajorStrg = 0;
055:          return;
056:       }
057:       if (Diag == CblasUnit) DI = 'U';
058:       else if (Diag == CblasNonUnit) DI = 'N';
059:       else
060:       {
061:          cblas_xerbla(4, "cblas_stpmv","Illegal Diag setting, %d\n", Diag);
062:          CBLAS_CallFromC = 0;
063:          RowMajorStrg = 0;
064:          return;
065:       }
066:       #ifdef F77_CHAR
067:          F77_UL = C2F_CHAR(&UL);
068:          F77_TA = C2F_CHAR(&TA);
069:          F77_DI = C2F_CHAR(&DI);
070:       #endif
071:       F77_stpmv( F77_UL, F77_TA, F77_DI, &F77_N, Ap, X, &F77_incX);
072:    }
073:    else if (order == CblasRowMajor)
074:    {
075:       RowMajorStrg = 1;
076:       if (Uplo == CblasUpper) UL = 'L';
077:       else if (Uplo == CblasLower) UL = 'U';
078:       else
079:       {
080:          cblas_xerbla(2, "cblas_stpmv","Illegal Uplo setting, %d\n", Uplo);
081:          CBLAS_CallFromC = 0;
082:          RowMajorStrg = 0;
083:          return;
084:       }
085: 
086:       if (TransA == CblasNoTrans) TA = 'T';
087:       else if (TransA == CblasTrans) TA = 'N';
088:       else if (TransA == CblasConjTrans) TA = 'N';
089:       else
090:       {
091:          cblas_xerbla(3, "cblas_stpmv","Illegal TransA setting, %d\n", TransA);
092:          CBLAS_CallFromC = 0;
093:          RowMajorStrg = 0;
094:          return;
095:       }
096: 
097:       if (Diag == CblasUnit) DI = 'U';
098:       else if (Diag == CblasNonUnit) DI = 'N';
099:       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: