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