17{
18 char TA;
19#ifdef F77_CHAR
21#else
22 #define F77_TA &TA
23#endif
24#ifdef F77_INT
26#else
27 #define F77_M M
28 #define F77_N N
29 #define F77_lda lda
30 #define F77_incX incx
31 #define F77_incY incY
32#endif
33
35 const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
36 double ALPHA[2],BETA[2];
38 double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
42
44
46 {
50 else
51 {
55 return;
56 }
57 #ifdef F77_CHAR
59 #endif
62 }
64 {
66
70 {
71 ALPHA[0]= *alp;
72 ALPHA[1]= -alp[1];
73 BETA[0]= *bet;
74 BETA[1]= -bet[1];
75 TA = 'N';
76 if (M > 0)
77 {
78 n = M << 1;
79 x = malloc(n*sizeof(double));
80 tx = x;
81 if( incX > 0 ) {
82 i = incX << 1 ;
83 tincx = 2;
84 st= x+n;
85 } else {
86 i = incX *(-2);
87 tincx = -2;
88 st = x-2;
89 x +=(n-2);
90 }
91
92 do
93 {
94 *x = *xx;
95 x[1] = -xx[1];
96 x += tincx ;
97 xx += i;
98 }
99 while (x != st);
100 x=tx;
101
102 #ifdef F77_INT
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 {
134 return;
135 }
136 #ifdef F77_CHAR
138 #endif
142 else
145
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 }
163 return;
164}
void cblas_xerbla(CBLAS_INT p, const char *rout, const char *form,...)