← Back to branch summary

~ubuntu-branches/ubuntu/vivid/atlas/vivid

« back to all changes in this revision

Viewing changes to interfaces/blas/C/testing/c_zblas2.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-04-13 10:07:52 UTC
  • Revision ID: james.westby@ubuntu.com-20020413100752-va9zm0rd4gpurdkq
Tags: upstream-3.2.1ln
Import upstream version 3.2.1ln

Show diffs side-by-side

added added

removed removed

Lines of Context:
interfaces/blas/C/testing/c_zblas2.c
 
1
/*
 
2
 *     Written by D.P. Manley, Digital Equipment Corporation.
 
3
 *     Prefixed "C_" to BLAS routines and their declarations.
 
4
 *
 
5
 *     Modified by T. H. Do, 4/08/98, SGI/CRAY Research.
 
6
 */
 
7
#include <stdlib.h>
 
8
#include "cblas.h"
 
9
#include "cblas_test.h"
 
10
 
 
11
void F77_zgemv(int *order, char *transp, int *m, int *n, 
 
12
          const void *alpha,
 
13
          CBLAS_TEST_ZOMPLEX *a, int *lda, const void *x, int *incx, 
 
14
          const void *beta, void *y, int *incy) {
 
15
 
 
16
  CBLAS_TEST_ZOMPLEX *A;
 
17
  int i,j,LDA;
 
18
  enum CBLAS_TRANSPOSE trans;
 
19
 
 
20
  get_transpose_type(transp, &trans);
 
21
  if (*order == TEST_ROW_MJR) {
 
22
     LDA = *n+1;
 
23
     A  = (CBLAS_TEST_ZOMPLEX *)malloc( (*m)*LDA*sizeof( CBLAS_TEST_ZOMPLEX) );
 
24
     for( i=0; i<*m; i++ )
 
25
        for( j=0; j<*n; j++ ){
 
26
           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
27
           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
28
        }
 
29
     cblas_zgemv( CblasRowMajor, trans, *m, *n, alpha, A, LDA, x, *incx,
 
30
            beta, y, *incy );
 
31
     free(A);
 
32
  }
 
33
  else if (*order == TEST_COL_MJR)
 
34
     cblas_zgemv( CblasColMajor, trans,
 
35
                  *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
 
36
  else
 
37
     cblas_zgemv( UNDEFINED, trans,
 
38
                  *m, *n, alpha, a, *lda, x, *incx, beta, y, *incy );
 
39
}
 
40
 
 
41
void F77_zgbmv(int *order, char *transp, int *m, int *n, int *kl, int *ku, 
 
42
              CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, 
 
43
              CBLAS_TEST_ZOMPLEX *x, int *incx, 
 
44
              CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy) {
 
45
 
 
46
  CBLAS_TEST_ZOMPLEX *A;
 
47
  int i,j,irow,jcol,LDA;
 
48
  enum CBLAS_TRANSPOSE trans;
 
49
 
 
50
  get_transpose_type(transp, &trans);
 
51
  if (*order == TEST_ROW_MJR) {
 
52
     LDA = *ku+*kl+2;
 
53
     A=( CBLAS_TEST_ZOMPLEX* )malloc((*n+*kl)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
54
     for( i=0; i<*ku; i++ ){
 
55
        irow=*ku+*kl-i;
 
56
        jcol=(*ku)-i;
 
57
        for( j=jcol; j<*n; j++ ){
 
58
           A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
 
59
           A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
 
60
        }
 
61
     }
 
62
     i=*ku;
 
63
     irow=*ku+*kl-i;
 
64
     for( j=0; j<*n; j++ ){
 
65
        A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
 
66
        A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
 
67
     }
 
68
     for( i=*ku+1; i<*ku+*kl+1; i++ ){
 
69
        irow=*ku+*kl-i;
 
70
        jcol=i-(*ku);
 
71
        for( j=jcol; j<(*n+*kl); j++ ){
 
72
           A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
 
73
           A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
 
74
        }
 
75
     }
 
76
     cblas_zgbmv( CblasRowMajor, trans, *m, *n, *kl, *ku, alpha, A, LDA, x,
 
77
                  *incx, beta, y, *incy );
 
78
     free(A);
 
79
  }
 
80
  else if (*order == TEST_COL_MJR)
 
81
     cblas_zgbmv( CblasColMajor, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
 
82
                  *incx, beta, y, *incy );
 
83
  else
 
84
     cblas_zgbmv( UNDEFINED, trans, *m, *n, *kl, *ku, alpha, a, *lda, x,
 
85
                  *incx, beta, y, *incy );
 
86
}
 
87
 
 
88
void F77_zgeru(int *order, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, 
 
89
         CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy, 
 
90
         CBLAS_TEST_ZOMPLEX *a, int *lda){
 
91
 
 
92
  CBLAS_TEST_ZOMPLEX *A;
 
93
  int i,j,LDA;
 
94
 
 
95
  if (*order == TEST_ROW_MJR) {
 
96
     LDA = *n+1;
 
97
     A=(CBLAS_TEST_ZOMPLEX*)malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
98
     for( i=0; i<*m; i++ )
 
99
        for( j=0; j<*n; j++ ){
 
100
           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
101
           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
102
     }
 
103
     cblas_zgeru( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
 
104
     for( i=0; i<*m; i++ )
 
105
        for( j=0; j<*n; j++ ){
 
106
           a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
 
107
           a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
 
108
        }
 
109
     free(A);
 
110
  }
 
111
  else if (*order == TEST_COL_MJR)
 
112
     cblas_zgeru( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 
113
  else
 
114
     cblas_zgeru( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 
115
}
 
116
 
 
117
void F77_zgerc(int *order, int *m, int *n, CBLAS_TEST_ZOMPLEX *alpha, 
 
118
         CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy, 
 
119
         CBLAS_TEST_ZOMPLEX *a, int *lda) {
 
120
  CBLAS_TEST_ZOMPLEX *A;
 
121
  int i,j,LDA;
 
122
 
 
123
  if (*order == TEST_ROW_MJR) {
 
124
     LDA = *n+1;
 
125
     A=(CBLAS_TEST_ZOMPLEX* )malloc((*m)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 
126
     for( i=0; i<*m; i++ )
 
127
        for( j=0; j<*n; j++ ){
 
128
           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
129
           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
130
        }
 
131
     cblas_zgerc( CblasRowMajor, *m, *n, alpha, x, *incx, y, *incy, A, LDA );
 
132
     for( i=0; i<*m; i++ )
 
133
        for( j=0; j<*n; j++ ){
 
134
           a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
 
135
           a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
 
136
        }
 
137
     free(A);
 
138
  }
 
139
  else if (*order == TEST_COL_MJR)
 
140
     cblas_zgerc( CblasColMajor, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 
141
  else
 
142
     cblas_zgerc( UNDEFINED, *m, *n, alpha, x, *incx, y, *incy, a, *lda );
 
143
}
 
144
 
 
145
void F77_zhemv(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 
146
      CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 
147
      int *incx, CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){
 
148
 
 
149
  CBLAS_TEST_ZOMPLEX *A;
 
150
  int i,j,LDA;
 
151
  enum CBLAS_UPLO uplo;
 
152
 
 
153
  get_uplo_type(uplow,&uplo);
 
154
 
 
155
  if (*order == TEST_ROW_MJR) {
 
156
     LDA = *n+1;
 
157
     A = (CBLAS_TEST_ZOMPLEX *)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
158
     for( i=0; i<*n; i++ )
 
159
        for( j=0; j<*n; j++ ){
 
160
           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
161
           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
162
     }
 
163
     cblas_zhemv( CblasRowMajor, uplo, *n, alpha, A, LDA, x, *incx,
 
164
            beta, y, *incy );
 
165
     free(A);
 
166
  }
 
167
  else if (*order == TEST_COL_MJR)
 
168
     cblas_zhemv( CblasColMajor, uplo, *n, alpha, a, *lda, x, *incx, 
 
169
           beta, y, *incy );
 
170
  else
 
171
     cblas_zhemv( UNDEFINED, uplo, *n, alpha, a, *lda, x, *incx,
 
172
           beta, y, *incy );
 
173
}
 
174
 
 
175
void F77_zhbmv(int *order, char *uplow, int *n, int *k,
 
176
     CBLAS_TEST_ZOMPLEX *alpha, CBLAS_TEST_ZOMPLEX *a, int *lda, 
 
177
     CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *beta,
 
178
     CBLAS_TEST_ZOMPLEX *y, int *incy){
 
179
 
 
180
CBLAS_TEST_ZOMPLEX *A;
 
181
int i,irow,j,jcol,LDA;
 
182
 
 
183
  enum CBLAS_UPLO uplo;
 
184
 
 
185
  get_uplo_type(uplow,&uplo);
 
186
 
 
187
  if (*order == TEST_ROW_MJR) {
 
188
     if (uplo != CblasUpper && uplo != CblasLower )
 
189
        cblas_zhbmv(CblasRowMajor, UNDEFINED, *n, *k, alpha, a, *lda, x, 
 
190
                 *incx, beta, y, *incy );
 
191
     else {
 
192
        LDA = *k+2;
 
193
        A =(CBLAS_TEST_ZOMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
194
        if (uplo == CblasUpper) {
 
195
           for( i=0; i<*k; i++ ){
 
196
              irow=*k-i;
 
197
              jcol=(*k)-i;
 
198
              for( j=jcol; j<*n; j++ ) {
 
199
                 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
 
200
                 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
 
201
              }
 
202
           }
 
203
           i=*k;
 
204
           irow=*k-i;
 
205
           for( j=0; j<*n; j++ ) {
 
206
              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
 
207
              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
 
208
           }
 
209
        }
 
210
        else {
 
211
           i=0;
 
212
           irow=*k-i;
 
213
           for( j=0; j<*n; j++ ) {
 
214
              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
 
215
              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
 
216
           }
 
217
           for( i=1; i<*k+1; i++ ){
 
218
              irow=*k-i;
 
219
              jcol=i;
 
220
              for( j=jcol; j<(*n+*k); j++ ) {
 
221
                 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
 
222
                 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
 
223
              }
 
224
           }
 
225
        }
 
226
        cblas_zhbmv( CblasRowMajor, uplo, *n, *k, alpha, A, LDA, x, *incx,
 
227
                     beta, y, *incy );
 
228
        free(A);
 
229
      }
 
230
   }
 
231
   else if (*order == TEST_COL_MJR)
 
232
     cblas_zhbmv(CblasColMajor, uplo, *n, *k, alpha, a, *lda, x, *incx,
 
233
                 beta, y, *incy );
 
234
   else
 
235
     cblas_zhbmv(UNDEFINED, uplo, *n, *k, alpha, a, *lda, x, *incx,
 
236
                 beta, y, *incy );
 
237
}
 
238
 
 
239
void F77_zhpmv(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 
240
     CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx, 
 
241
     CBLAS_TEST_ZOMPLEX *beta, CBLAS_TEST_ZOMPLEX *y, int *incy){
 
242
 
 
243
  CBLAS_TEST_ZOMPLEX *A, *AP;
 
244
  int i,j,k,LDA;
 
245
  enum CBLAS_UPLO uplo;
 
246
 
 
247
  get_uplo_type(uplow,&uplo);
 
248
  if (*order == TEST_ROW_MJR) {
 
249
     if (uplo != CblasUpper && uplo != CblasLower )
 
250
        cblas_zhpmv(CblasRowMajor, UNDEFINED, *n, alpha, ap, x, *incx, 
 
251
                 beta, y, *incy);
 
252
     else {
 
253
        LDA = *n;
 
254
        A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
 
255
        AP = (CBLAS_TEST_ZOMPLEX* )malloc( (((LDA+1)*LDA)/2)*
 
256
                sizeof( CBLAS_TEST_ZOMPLEX ));
 
257
        if (uplo == CblasUpper) {
 
258
           for( j=0, k=0; j<*n; j++ )
 
259
              for( i=0; i<j+1; i++, k++ ) {
 
260
                 A[ LDA*i+j ].real=ap[ k ].real;
 
261
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
262
              }
 
263
           for( i=0, k=0; i<*n; i++ )
 
264
              for( j=i; j<*n; j++, k++ ) {
 
265
                 AP[ k ].real=A[ LDA*i+j ].real;
 
266
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
267
              }
 
268
        }
 
269
        else {
 
270
           for( j=0, k=0; j<*n; j++ )
 
271
              for( i=j; i<*n; i++, k++ ) {
 
272
                 A[ LDA*i+j ].real=ap[ k ].real;
 
273
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
274
              }
 
275
           for( i=0, k=0; i<*n; i++ )
 
276
              for( j=0; j<i+1; j++, k++ ) {
 
277
                 AP[ k ].real=A[ LDA*i+j ].real;
 
278
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
279
              }
 
280
        }
 
281
        cblas_zhpmv( CblasRowMajor, uplo, *n, alpha, AP, x, *incx, beta, y,
 
282
                     *incy );
 
283
        free(A);
 
284
        free(AP);
 
285
     }
 
286
  }
 
287
  else if (*order == TEST_COL_MJR)
 
288
     cblas_zhpmv( CblasColMajor, uplo, *n, alpha, ap, x, *incx, beta, y,
 
289
                  *incy );
 
290
  else
 
291
     cblas_zhpmv( UNDEFINED, uplo, *n, alpha, ap, x, *incx, beta, y,
 
292
                  *incy );
 
293
}
 
294
 
 
295
void F77_ztbmv(int *order, char *uplow, char *transp, char *diagn,
 
296
     int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 
297
     int *incx) {
 
298
  CBLAS_TEST_ZOMPLEX *A;
 
299
  int irow, jcol, i, j, LDA;
 
300
  enum CBLAS_TRANSPOSE trans;
 
301
  enum CBLAS_UPLO uplo;
 
302
  enum CBLAS_DIAG diag;
 
303
 
 
304
  get_transpose_type(transp,&trans);
 
305
  get_uplo_type(uplow,&uplo);
 
306
  get_diag_type(diagn,&diag);
 
307
 
 
308
  if (*order == TEST_ROW_MJR) {
 
309
     if (uplo != CblasUpper && uplo != CblasLower )
 
310
        cblas_ztbmv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda,
 
311
        x, *incx);
 
312
     else {
 
313
        LDA = *k+2;
 
314
        A=(CBLAS_TEST_ZOMPLEX *)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
315
        if (uplo == CblasUpper) {
 
316
           for( i=0; i<*k; i++ ){
 
317
              irow=*k-i;
 
318
              jcol=(*k)-i;
 
319
              for( j=jcol; j<*n; j++ ) {
 
320
                 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
 
321
                 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
 
322
              }
 
323
           }
 
324
           i=*k;
 
325
           irow=*k-i;
 
326
           for( j=0; j<*n; j++ ) {
 
327
              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
 
328
              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
 
329
           }
 
330
        }
 
331
        else {
 
332
          i=0;
 
333
          irow=*k-i;
 
334
          for( j=0; j<*n; j++ ) {
 
335
             A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
 
336
             A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
 
337
          }
 
338
          for( i=1; i<*k+1; i++ ){
 
339
             irow=*k-i;
 
340
             jcol=i;
 
341
             for( j=jcol; j<(*n+*k); j++ ) {
 
342
                A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
 
343
                A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
 
344
             }
 
345
          }
 
346
        }
 
347
        cblas_ztbmv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, x, 
 
348
                    *incx);
 
349
        free(A);
 
350
     }
 
351
   }
 
352
   else if (*order == TEST_COL_MJR)
 
353
     cblas_ztbmv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 
354
   else
 
355
     cblas_ztbmv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 
356
}
 
357
 
 
358
void F77_ztbsv(int *order, char *uplow, char *transp, char *diagn,
 
359
      int *n, int *k, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 
360
      int *incx) {
 
361
 
 
362
  CBLAS_TEST_ZOMPLEX *A;
 
363
  int irow, jcol, i, j, LDA;
 
364
  enum CBLAS_TRANSPOSE trans;
 
365
  enum CBLAS_UPLO uplo;
 
366
  enum CBLAS_DIAG diag;
 
367
 
 
368
  get_transpose_type(transp,&trans);
 
369
  get_uplo_type(uplow,&uplo);
 
370
  get_diag_type(diagn,&diag);
 
371
 
 
372
  if (*order == TEST_ROW_MJR) {
 
373
     if (uplo != CblasUpper && uplo != CblasLower )
 
374
        cblas_ztbsv(CblasRowMajor, UNDEFINED, trans, diag, *n, *k, a, *lda, x, 
 
375
                 *incx);
 
376
     else {
 
377
        LDA = *k+2;
 
378
        A=(CBLAS_TEST_ZOMPLEX*)malloc((*n+*k)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ));
 
379
        if (uplo == CblasUpper) {
 
380
           for( i=0; i<*k; i++ ){
 
381
              irow=*k-i;
 
382
              jcol=(*k)-i;
 
383
              for( j=jcol; j<*n; j++ ) {
 
384
                 A[ LDA*(j-jcol)+irow ].real=a[ (*lda)*j+i ].real;
 
385
                 A[ LDA*(j-jcol)+irow ].imag=a[ (*lda)*j+i ].imag;
 
386
              }
 
387
           }
 
388
           i=*k;
 
389
           irow=*k-i;
 
390
           for( j=0; j<*n; j++ ) {
 
391
              A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
 
392
              A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
 
393
           }
 
394
        }
 
395
        else {
 
396
           i=0;
 
397
           irow=*k-i;
 
398
           for( j=0; j<*n; j++ ) {
 
399
             A[ LDA*j+irow ].real=a[ (*lda)*j+i ].real;
 
400
             A[ LDA*j+irow ].imag=a[ (*lda)*j+i ].imag;
 
401
           }
 
402
           for( i=1; i<*k+1; i++ ){
 
403
              irow=*k-i;
 
404
              jcol=i;
 
405
              for( j=jcol; j<(*n+*k); j++ ) {
 
406
                 A[ LDA*j+irow ].real=a[ (*lda)*(j-jcol)+i ].real;
 
407
                 A[ LDA*j+irow ].imag=a[ (*lda)*(j-jcol)+i ].imag;
 
408
              }
 
409
           }
 
410
        }
 
411
        cblas_ztbsv(CblasRowMajor, uplo, trans, diag, *n, *k, A, LDA, 
 
412
                    x, *incx);
 
413
        free(A);
 
414
     }
 
415
  }
 
416
  else if (*order == TEST_COL_MJR)
 
417
     cblas_ztbsv(CblasColMajor, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 
418
  else
 
419
     cblas_ztbsv(UNDEFINED, uplo, trans, diag, *n, *k, a, *lda, x, *incx);
 
420
}
 
421
 
 
422
void F77_ztpmv(int *order, char *uplow, char *transp, char *diagn,
 
423
      int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) {
 
424
  CBLAS_TEST_ZOMPLEX *A, *AP;
 
425
  int i, j, k, LDA;
 
426
  enum CBLAS_TRANSPOSE trans;
 
427
  enum CBLAS_UPLO uplo;
 
428
  enum CBLAS_DIAG diag;
 
429
 
 
430
  get_transpose_type(transp,&trans);
 
431
  get_uplo_type(uplow,&uplo);
 
432
  get_diag_type(diagn,&diag);
 
433
 
 
434
  if (*order == TEST_ROW_MJR) {
 
435
     if (uplo != CblasUpper && uplo != CblasLower )
 
436
        cblas_ztpmv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
 
437
     else {
 
438
        LDA = *n;
 
439
        A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
440
        AP=(CBLAS_TEST_ZOMPLEX*)malloc((((LDA+1)*LDA)/2)*
 
441
                sizeof(CBLAS_TEST_ZOMPLEX));
 
442
        if (uplo == CblasUpper) {
 
443
           for( j=0, k=0; j<*n; j++ )
 
444
              for( i=0; i<j+1; i++, k++ ) {
 
445
                 A[ LDA*i+j ].real=ap[ k ].real;
 
446
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
447
              }
 
448
           for( i=0, k=0; i<*n; i++ )
 
449
              for( j=i; j<*n; j++, k++ ) {
 
450
                 AP[ k ].real=A[ LDA*i+j ].real;
 
451
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
452
              }
 
453
        }
 
454
        else {
 
455
           for( j=0, k=0; j<*n; j++ )
 
456
              for( i=j; i<*n; i++, k++ ) {
 
457
                 A[ LDA*i+j ].real=ap[ k ].real;
 
458
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
459
              }
 
460
           for( i=0, k=0; i<*n; i++ )
 
461
              for( j=0; j<i+1; j++, k++ ) {
 
462
                 AP[ k ].real=A[ LDA*i+j ].real;
 
463
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
464
              }
 
465
        }
 
466
        cblas_ztpmv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
 
467
        free(A);
 
468
        free(AP);
 
469
     }
 
470
  }
 
471
  else if (*order == TEST_COL_MJR)
 
472
     cblas_ztpmv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
 
473
  else
 
474
     cblas_ztpmv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
 
475
}
 
476
 
 
477
void F77_ztpsv(int *order, char *uplow, char *transp, char *diagn,
 
478
     int *n, CBLAS_TEST_ZOMPLEX *ap, CBLAS_TEST_ZOMPLEX *x, int *incx) {
 
479
  CBLAS_TEST_ZOMPLEX *A, *AP;
 
480
  int i, j, k, LDA;
 
481
  enum CBLAS_TRANSPOSE trans;
 
482
  enum CBLAS_UPLO uplo;
 
483
  enum CBLAS_DIAG diag;
 
484
 
 
485
  get_transpose_type(transp,&trans);
 
486
  get_uplo_type(uplow,&uplo);
 
487
  get_diag_type(diagn,&diag);
 
488
 
 
489
  if (*order == TEST_ROW_MJR) {
 
490
     if (uplo != CblasUpper && uplo != CblasLower )
 
491
        cblas_ztpsv( CblasRowMajor, UNDEFINED, trans, diag, *n, ap, x, *incx );
 
492
     else {
 
493
        LDA = *n;
 
494
        A=(CBLAS_TEST_ZOMPLEX*)malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
495
        AP=(CBLAS_TEST_ZOMPLEX*)malloc((((LDA+1)*LDA)/2)*
 
496
                sizeof(CBLAS_TEST_ZOMPLEX));
 
497
        if (uplo == CblasUpper) {
 
498
           for( j=0, k=0; j<*n; j++ )
 
499
              for( i=0; i<j+1; i++, k++ ) {
 
500
                 A[ LDA*i+j ].real=ap[ k ].real;
 
501
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
502
              }
 
503
           for( i=0, k=0; i<*n; i++ )
 
504
              for( j=i; j<*n; j++, k++ ) {
 
505
                 AP[ k ].real=A[ LDA*i+j ].real;
 
506
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
507
              }
 
508
        }
 
509
        else {
 
510
           for( j=0, k=0; j<*n; j++ )
 
511
              for( i=j; i<*n; i++, k++ ) {
 
512
                 A[ LDA*i+j ].real=ap[ k ].real;
 
513
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
514
              }
 
515
           for( i=0, k=0; i<*n; i++ )
 
516
              for( j=0; j<i+1; j++, k++ ) {
 
517
                 AP[ k ].real=A[ LDA*i+j ].real;
 
518
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
519
              }
 
520
        }
 
521
        cblas_ztpsv( CblasRowMajor, uplo, trans, diag, *n, AP, x, *incx );
 
522
        free(A);
 
523
        free(AP);
 
524
     }
 
525
  }
 
526
  else if (*order == TEST_COL_MJR)
 
527
     cblas_ztpsv( CblasColMajor, uplo, trans, diag, *n, ap, x, *incx );
 
528
  else
 
529
     cblas_ztpsv( UNDEFINED, uplo, trans, diag, *n, ap, x, *incx );
 
530
}
 
531
 
 
532
void F77_ztrmv(int *order, char *uplow, char *transp, char *diagn,
 
533
     int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 
534
      int *incx) {
 
535
  CBLAS_TEST_ZOMPLEX *A;
 
536
  int i,j,LDA;
 
537
  enum CBLAS_TRANSPOSE trans;
 
538
  enum CBLAS_UPLO uplo;
 
539
  enum CBLAS_DIAG diag;
 
540
 
 
541
  get_transpose_type(transp,&trans);
 
542
  get_uplo_type(uplow,&uplo);
 
543
  get_diag_type(diagn,&diag);
 
544
 
 
545
  if (*order == TEST_ROW_MJR) {
 
546
     LDA=*n+1;
 
547
     A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX));
 
548
     for( i=0; i<*n; i++ )
 
549
       for( j=0; j<*n; j++ ) {
 
550
          A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
551
          A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
552
       }
 
553
     cblas_ztrmv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx);
 
554
     free(A);
 
555
  }
 
556
  else if (*order == TEST_COL_MJR)
 
557
     cblas_ztrmv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx);
 
558
  else
 
559
     cblas_ztrmv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx);
 
560
}
 
561
void F77_ztrsv(int *order, char *uplow, char *transp, char *diagn,
 
562
       int *n, CBLAS_TEST_ZOMPLEX *a, int *lda, CBLAS_TEST_ZOMPLEX *x,
 
563
              int *incx) {
 
564
  CBLAS_TEST_ZOMPLEX *A;
 
565
  int i,j,LDA;
 
566
  enum CBLAS_TRANSPOSE trans;
 
567
  enum CBLAS_UPLO uplo;
 
568
  enum CBLAS_DIAG diag;
 
569
 
 
570
  get_transpose_type(transp,&trans);
 
571
  get_uplo_type(uplow,&uplo);
 
572
  get_diag_type(diagn,&diag);
 
573
 
 
574
  if (*order == TEST_ROW_MJR) {
 
575
     LDA = *n+1;
 
576
     A =(CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 
577
     for( i=0; i<*n; i++ )
 
578
        for( j=0; j<*n; j++ ) {
 
579
           A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
580
           A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
581
        }
 
582
     cblas_ztrsv(CblasRowMajor, uplo, trans, diag, *n, A, LDA, x, *incx );
 
583
     free(A);
 
584
   }
 
585
   else if (*order == TEST_COL_MJR)
 
586
     cblas_ztrsv(CblasColMajor, uplo, trans, diag, *n, a, *lda, x, *incx );
 
587
   else
 
588
     cblas_ztrsv(UNDEFINED, uplo, trans, diag, *n, a, *lda, x, *incx );
 
589
}
 
590
 
 
591
void F77_zhpr(int *order, char *uplow, int *n, double *alpha,
 
592
             CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *ap) {
 
593
  CBLAS_TEST_ZOMPLEX *A, *AP;
 
594
  int i,j,k,LDA;
 
595
  enum CBLAS_UPLO uplo;
 
596
 
 
597
  get_uplo_type(uplow,&uplo);
 
598
 
 
599
  if (*order == TEST_ROW_MJR) {
 
600
     if (uplo != CblasUpper && uplo != CblasLower )
 
601
        cblas_zhpr(CblasRowMajor, UNDEFINED, *n, *alpha, x, *incx, ap );
 
602
     else {
 
603
        LDA = *n;
 
604
        A = (CBLAS_TEST_ZOMPLEX* )malloc(LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 
605
        AP = ( CBLAS_TEST_ZOMPLEX* )malloc( (((LDA+1)*LDA)/2)*
 
606
                sizeof( CBLAS_TEST_ZOMPLEX ));
 
607
        if (uplo == CblasUpper) {
 
608
           for( j=0, k=0; j<*n; j++ )
 
609
              for( i=0; i<j+1; i++, k++ ){
 
610
                 A[ LDA*i+j ].real=ap[ k ].real;
 
611
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
612
              }
 
613
           for( i=0, k=0; i<*n; i++ )
 
614
              for( j=i; j<*n; j++, k++ ){
 
615
                 AP[ k ].real=A[ LDA*i+j ].real;
 
616
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
617
              }
 
618
        }
 
619
        else {
 
620
           for( j=0, k=0; j<*n; j++ )
 
621
              for( i=j; i<*n; i++, k++ ){
 
622
                 A[ LDA*i+j ].real=ap[ k ].real;
 
623
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
624
              }
 
625
           for( i=0, k=0; i<*n; i++ )
 
626
              for( j=0; j<i+1; j++, k++ ){
 
627
                 AP[ k ].real=A[ LDA*i+j ].real;
 
628
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
629
              }
 
630
        }
 
631
        cblas_zhpr(CblasRowMajor, uplo, *n, *alpha, x, *incx, AP );
 
632
        if (uplo == CblasUpper) {
 
633
           for( i=0, k=0; i<*n; i++ )
 
634
              for( j=i; j<*n; j++, k++ ){
 
635
                 A[ LDA*i+j ].real=AP[ k ].real;
 
636
                 A[ LDA*i+j ].imag=AP[ k ].imag;
 
637
              }
 
638
           for( j=0, k=0; j<*n; j++ )
 
639
              for( i=0; i<j+1; i++, k++ ){
 
640
                 ap[ k ].real=A[ LDA*i+j ].real;
 
641
                 ap[ k ].imag=A[ LDA*i+j ].imag;
 
642
              }
 
643
        }
 
644
        else {
 
645
           for( i=0, k=0; i<*n; i++ )
 
646
              for( j=0; j<i+1; j++, k++ ){
 
647
                 A[ LDA*i+j ].real=AP[ k ].real;
 
648
                 A[ LDA*i+j ].imag=AP[ k ].imag;
 
649
              }
 
650
           for( j=0, k=0; j<*n; j++ )
 
651
              for( i=j; i<*n; i++, k++ ){
 
652
                 ap[ k ].real=A[ LDA*i+j ].real;
 
653
                 ap[ k ].imag=A[ LDA*i+j ].imag;
 
654
              }
 
655
        }
 
656
        free(A);
 
657
        free(AP);
 
658
     }
 
659
  }
 
660
  else if (*order == TEST_COL_MJR)
 
661
     cblas_zhpr(CblasColMajor, uplo, *n, *alpha, x, *incx, ap );
 
662
  else
 
663
     cblas_zhpr(UNDEFINED, uplo, *n, *alpha, x, *incx, ap );
 
664
}
 
665
 
 
666
void F77_zhpr2(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 
667
       CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
 
668
       CBLAS_TEST_ZOMPLEX *ap) {
 
669
  CBLAS_TEST_ZOMPLEX *A, *AP;
 
670
  int i,j,k,LDA;
 
671
  enum CBLAS_UPLO uplo;
 
672
 
 
673
  get_uplo_type(uplow,&uplo);
 
674
 
 
675
  if (*order == TEST_ROW_MJR) {
 
676
     if (uplo != CblasUpper && uplo != CblasLower )
 
677
        cblas_zhpr2( CblasRowMajor, UNDEFINED, *n, alpha, x, *incx, y, 
 
678
                     *incy, ap );
 
679
     else {
 
680
        LDA = *n;
 
681
        A=(CBLAS_TEST_ZOMPLEX*)malloc( LDA*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 
682
        AP=(CBLAS_TEST_ZOMPLEX*)malloc( (((LDA+1)*LDA)/2)*
 
683
        sizeof( CBLAS_TEST_ZOMPLEX ));
 
684
        if (uplo == CblasUpper) {
 
685
           for( j=0, k=0; j<*n; j++ )
 
686
              for( i=0; i<j+1; i++, k++ ) {
 
687
                 A[ LDA*i+j ].real=ap[ k ].real;
 
688
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
689
              }
 
690
           for( i=0, k=0; i<*n; i++ )
 
691
              for( j=i; j<*n; j++, k++ ) {
 
692
                 AP[ k ].real=A[ LDA*i+j ].real;
 
693
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
694
              }
 
695
        }
 
696
        else {
 
697
           for( j=0, k=0; j<*n; j++ )
 
698
              for( i=j; i<*n; i++, k++ ) {
 
699
                 A[ LDA*i+j ].real=ap[ k ].real;
 
700
                 A[ LDA*i+j ].imag=ap[ k ].imag;
 
701
              }
 
702
           for( i=0, k=0; i<*n; i++ )
 
703
              for( j=0; j<i+1; j++, k++ ) {
 
704
                 AP[ k ].real=A[ LDA*i+j ].real;
 
705
                 AP[ k ].imag=A[ LDA*i+j ].imag;
 
706
              }
 
707
        }
 
708
        cblas_zhpr2( CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, AP );
 
709
        if (uplo == CblasUpper) {
 
710
           for( i=0, k=0; i<*n; i++ )
 
711
              for( j=i; j<*n; j++, k++ ) {
 
712
                 A[ LDA*i+j ].real=AP[ k ].real;
 
713
                 A[ LDA*i+j ].imag=AP[ k ].imag;
 
714
              }
 
715
           for( j=0, k=0; j<*n; j++ )
 
716
              for( i=0; i<j+1; i++, k++ ) {
 
717
                 ap[ k ].real=A[ LDA*i+j ].real;
 
718
                 ap[ k ].imag=A[ LDA*i+j ].imag;
 
719
              }
 
720
        }
 
721
        else {
 
722
           for( i=0, k=0; i<*n; i++ )
 
723
              for( j=0; j<i+1; j++, k++ ) {
 
724
                 A[ LDA*i+j ].real=AP[ k ].real;
 
725
                 A[ LDA*i+j ].imag=AP[ k ].imag;
 
726
              }
 
727
           for( j=0, k=0; j<*n; j++ )
 
728
              for( i=j; i<*n; i++, k++ ) {
 
729
                 ap[ k ].real=A[ LDA*i+j ].real;
 
730
                 ap[ k ].imag=A[ LDA*i+j ].imag;
 
731
              }
 
732
        }
 
733
        free(A);
 
734
        free(AP);
 
735
     }
 
736
  }
 
737
  else if (*order == TEST_COL_MJR)
 
738
     cblas_zhpr2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, ap );
 
739
  else
 
740
     cblas_zhpr2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, ap );
 
741
}
 
742
 
 
743
void F77_zher(int *order, char *uplow, int *n, double *alpha,
 
744
  CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *a, int *lda) {
 
745
  CBLAS_TEST_ZOMPLEX *A;
 
746
  int i,j,LDA;
 
747
  enum CBLAS_UPLO uplo;
 
748
 
 
749
  get_uplo_type(uplow,&uplo);
 
750
 
 
751
  if (*order == TEST_ROW_MJR) {
 
752
     LDA = *n+1;
 
753
     A=(CBLAS_TEST_ZOMPLEX*)malloc((*n)*LDA*sizeof( CBLAS_TEST_ZOMPLEX ));
 
754
 
 
755
     for( i=0; i<*n; i++ ) 
 
756
       for( j=0; j<*n; j++ ) {
 
757
          A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
758
          A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
759
       }
 
760
 
 
761
     cblas_zher(CblasRowMajor, uplo, *n, *alpha, x, *incx, A, LDA );
 
762
     for( i=0; i<*n; i++ )
 
763
       for( j=0; j<*n; j++ ) {
 
764
          a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
 
765
          a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
 
766
       }
 
767
     free(A);
 
768
  }
 
769
  else if (*order == TEST_COL_MJR)
 
770
     cblas_zher( CblasColMajor, uplo, *n, *alpha, x, *incx, a, *lda );
 
771
  else
 
772
     cblas_zher( UNDEFINED, uplo, *n, *alpha, x, *incx, a, *lda );
 
773
}
 
774
 
 
775
void F77_zher2(int *order, char *uplow, int *n, CBLAS_TEST_ZOMPLEX *alpha,
 
776
          CBLAS_TEST_ZOMPLEX *x, int *incx, CBLAS_TEST_ZOMPLEX *y, int *incy,
 
777
          CBLAS_TEST_ZOMPLEX *a, int *lda) {
 
778
 
 
779
  CBLAS_TEST_ZOMPLEX *A;
 
780
  int i,j,LDA;
 
781
  enum CBLAS_UPLO uplo;
 
782
 
 
783
  get_uplo_type(uplow,&uplo);
 
784
 
 
785
  if (*order == TEST_ROW_MJR) {
 
786
     LDA = *n+1;
 
787
     A= ( CBLAS_TEST_ZOMPLEX* )malloc((*n)*LDA*sizeof(CBLAS_TEST_ZOMPLEX ) );
 
788
 
 
789
     for( i=0; i<*n; i++ ) 
 
790
       for( j=0; j<*n; j++ ) {
 
791
          A[ LDA*i+j ].real=a[ (*lda)*j+i ].real;
 
792
          A[ LDA*i+j ].imag=a[ (*lda)*j+i ].imag;
 
793
       }
 
794
 
 
795
     cblas_zher2(CblasRowMajor, uplo, *n, alpha, x, *incx, y, *incy, A, LDA );
 
796
     for( i=0; i<*n; i++ )
 
797
       for( j=0; j<*n; j++ ) {
 
798
          a[ (*lda)*j+i ].real=A[ LDA*i+j ].real;
 
799
          a[ (*lda)*j+i ].imag=A[ LDA*i+j ].imag;
 
800
       }
 
801
     free(A);
 
802
  }
 
803
  else if (*order == TEST_COL_MJR)
 
804
     cblas_zher2( CblasColMajor, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
 
805
  else
 
806
     cblas_zher2( UNDEFINED, uplo, *n, alpha, x, *incx, y, *incy, a, *lda);
 
807
}