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