001: /*
002:  * cblas_chbmv.c
003:  * The program is a C interface to chbmv
004:  *
005:  * Keita Teranishi  5/18/98
006:  *
007:  */
008: #include "cblas.h"
009: #include "cblas_f77.h"
010: #include <stdio.h>
011: #include <stdlib.h>
012: void cblas_chbmv(const enum CBLAS_ORDER order,
013:                  const enum CBLAS_UPLO Uplo,const int N,const int K,
014:                  const void *alpha, const void  *A, const int lda,
015:                  const void  *X, const int incX, const void *beta,
016:                  void  *Y, const int incY)
017: {
018:    char UL;
019: #ifdef F77_CHAR
020:    F77_CHAR F77_UL;
021: #else
022:    #define F77_UL &UL
023: #endif
024: #ifdef F77_INT
025:    F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
026: #else
027:    #define F77_N N
028:    #define F77_K K
029:    #define F77_lda lda
030:    #define F77_incX incx
031:    #define F77_incY incY
032: #endif
033:    int n, i=0, incx=incX;
034:    const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
035:    float ALPHA[2],BETA[2];
036:    int tincY, tincx;
037:    float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
038:    extern int CBLAS_CallFromC;
039:    extern int RowMajorStrg;
040:    RowMajorStrg = 0;
041: 
042:    CBLAS_CallFromC = 1;
043:    if (order == CblasColMajor)
044:    {
045:       if (Uplo == CblasLower) UL = 'L';
046:       else if (Uplo == CblasUpper) UL = 'U';
047:       else
048:       {
049:          cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n",Uplo );
050:          CBLAS_CallFromC = 0;
051:          RowMajorStrg = 0;
052:          return;
053:       }
054:       #ifdef F77_CHAR
055:          F77_UL = C2F_CHAR(&UL);
056:       #endif
057:       F77_chbmv(F77_UL, &F77_N, &F77_K, alpha, A, &F77_lda, X,
058:                      &F77_incX, beta, Y, &F77_incY);
059:    }
060:    else if (order == CblasRowMajor)
061:    {
062:       RowMajorStrg = 1;
063:       ALPHA[0]= *alp;
064:       ALPHA[1]= -alp[1];
065:       BETA[0]= *bet;
066:       BETA[1]= -bet[1];
067: 
068:       if (N > 0)
069:       {
070:          n = N << 1;
071:          x = (float *)malloc(n*sizeof(float));
072: 
073:          tx = x;
074:          if( incX > 0 ) {
075:            i = incX << 1 ;
076:            tincx = 2;
077:            st= x+n;
078:          } else {
079:            i = incX *(-2);
080:            tincx = -2;
081:            st = x-2;
082:            x +=(n-2);
083:          }
084: 
085:          do
086:          {
087:            *x = *xx;
088:            x[1] = -xx[1];
089:            x += tincx ;
090:            xx += i;
091:          }
092:          while (x != st);
093:          x=tx;
094: 
095: 
096:          #ifdef F77_INT
097:             F77_incX = 1;
098:          #else
099:             incx = 1;
100:          #endif
101: 
102:          if(incY > 0)
103:            tincY = incY;
104:          else
105:            tincY = -incY;
106:          y++;
107: 
108:          i = tincY << 1;
109:          n = i * N ;
110:          st = y + n;
111:          do {
112:             *y = -(*y);
113:             y += i;
114:          } while(y != st);
115:          y -= n;
116:       }  else
117:          x = (float *) X;
118: 
119:       if (Uplo == CblasUpper) UL = 'L';
120:       else if (Uplo == CblasLower) UL = 'U';
121:       else
122:       {
123:          cblas_xerbla(2, "cblas_chbmv","Illegal Uplo setting, %d\n", Uplo);
124:          CBLAS_CallFromC = 0;
125:          RowMajorStrg = 0;
126:          return;
127:       }
128:       #ifdef F77_CHAR
129:          F77_UL = C2F_CHAR(&UL);
130:       #endif
131:       F77_chbmv(F77_UL, &F77_N, &F77_K, ALPHA,
132:                      A ,&F77_lda, x,&F77_incX, BETA, Y, &F77_incY);
133:    }
134:    else
135:    {
136:       cblas_xerbla(1, "cblas_chbmv","Illegal Order setting, %d\n", order);
137:       CBLAS_CallFromC = 0;
138:       RowMajorStrg = 0;
139:       return;
140:    }
141:    if ( order == CblasRowMajor )
142:    {
143:       RowMajorStrg = 1;
144:       if(X!=x)
145:          free(x);
146:       if (N > 0)
147:       {
148:          do
149:          {
150:             *y = -(*y);
151:             y += i;
152:          }
153:          while (y != st);
154:       }
155:    }
156:    CBLAS_CallFromC = 0;
157:    RowMajorStrg = 0;
158:    return;
159: }
160: