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