1dnl **********************************************************************
2dnl * Generates alpha, T, x, and y, where T is a triangular  matrix;     *
3dnl * and computes r_true.                                               *
4dnl **********************************************************************
5dnl
6dnl
7include(cblas.m4)dnl
8include(test-common.m4)dnl
9dnl
10dnl
11define(`TRSV_TESTGEN_COMMENT', `
12/*
13 * Purpose
14 * =======
15 *
16 * Generates alpha, x and T, where T is a triangular matrix; and computes r_true.
17 *
18 * Arguments
19 * =========
20 *
21 * norm         (input) blas_norm_type
22 *
23 * order        (input) blas_order_type
24 *              Order of T; row or column major
25 *
26 * uplo         (input) blas_uplo_type
27 *              Whether T is upper or lower
28 *
29 * trans        (input) blas_trans_type
30 *              No trans, trans, conj trans
31 *
32 * diag         (input) blas_diag_type
33 *              non unit, unit
34 *
35 * n            (input) int
36 *              Dimension of AP and the length of vector x
37 *
38 * alpha        (input/output) $1_array
39 *              If alpha_flag = 1, alpha is input.
40 *              If alpha_flag = 0, alpha is output.
41 *
42 * alpha_flag   (input) int
43 *              = 0 : alpha is free, and is output.
44 *              = 1 : alpha is fixed on input.
45 *
46 * T            (output) $2_array
47 *
48 * x            (input/output) $1_array
49 *
50 * seed         (input/output) int
51 *
52 * HEAD(r_true)     (output) double*
53 *              The leading part of the truth in double-double.
54 *
55 * TAIL(r_true)     (output) double*
56 *              The trailing part of the truth in double-double.
57 *
58 * row          (input) int
59 *              The true row being generated
60 *
61 * prec         (input) blas_prec_type
62 *              single, double, or extra precision
63 *
64 */')dnl
65dnl
66dnl
67dnl
68dnl ---------------------------------------------------------------------
69dnl Usage: TRSV_TESTGEN(ax_typeltr, T_typeltr)
70dnl        produce trsv_prepare signature
71dnl ---------------------------------------------------------------------
72define(`TRSV_TESTGEN_NAME',
73  `BLAS_$1trsv`'ifelse(`$1', `$2', `', `_$2')_testgen')dnl
74dnl
75dnl
76define(`TRSV_TESTGEN_HEAD',
77  `void TRSV_TESTGEN_NAME($1, $2)(int norm, enum blas_order_type order, dnl
78       enum blas_uplo_type uplo, enum blas_trans_type trans, dnl
79       enum blas_diag_type diag, int n, $1_array alpha, int alpha_flag, dnl
80       $2_array T, int lda, $1_array x,  int *seed, dnl
81       double *HEAD(r_true), double *TAIL(r_true), int row, dnl
82       enum blas_prec_type prec)')dnl
83dnl
84dnl
85define(`TRSV_TESTGEN', `dnl
86TRSV_TESTGEN_HEAD($1, $2)
87TRSV_TESTGEN_COMMENT($1, $2)
88IF_REAL($1_type, `TRSV_TESTGEN_BODY($1, $2)',
89  `IF_REAL($2_type,
90    `TRSV_TESTGEN_MIX_COMPLEX_BODY($1, $2)',
91    `TRSV_TESTGEN_PURE_COMPLEX_BODY($1, $2)')'
92)')dnl
93dnl
94dnl
95dnl ---------------------------------------------------------------------
96dnl Usage: TRSV_TESTGEN_BODY(ax_typeltr, T_typeltr)
97dnl
98dnl ---------------------------------------------------------------------
99define(`TRSV_TESTGEN_BODY',
100`{
101  int start;
102  int length;
103  int i, j;
104  DECLARE(alpha_i, real_S)
105  DECLARE(minus_one, $1_type)
106  DECLARE(Tii, $2_type)
107  DECLARE_VECTOR(temp, $2_type)
108  DECLARE_VECTOR(xtemp2, $1_type)
109
110  MALLOC_VECTOR(temp, $2_type, n)
111
112  xtemp2 = NULL;
113  if (prec!=blas_prec_extra){
114    MALLOC_VECTOR(xtemp2, $1_type, n)
115  }
116
117  minus_one = -1.0;
118
119  /* if alpha_flag=0, gives a random value to alpha */
120  if (alpha_flag == 0){
121    alpha_i = xrand(seed);
122    *alpha = alpha_i;
123    alpha_flag = 1;
124  }
125
126  for(i=0; i<4*n*n; i++){
127    ZERO(T[i], $1_type)
128  }
129
130  for(i=0; i<n; i++){
131
132    if (i!=row){
133      if (diag == blas_non_unit_diag){
134        Tii   = xrand(seed);
135        SET_VECTOR_ELEMENT(T, i*lda+i, Tii, $2_type)
136      }
137      else {
138        ONE(Tii, $2_type)
139        SET_VECTOR_ELEMENT(T, i*lda+i, Tii, $2_type)
140      }
141
142      x[i] = xrand(seed);
143
144      switch(prec){
145      case blas_prec_single:
146      {
147          DECLARE(multemp, $1_type)
148          DECLARE(divtemp, $1_type)
149
150          MUL(multemp, $1_type, x[i], $1_type, *alpha, $1_type)
151          DIV(divtemp, $1_type, multemp, $1_type, Tii, $2_type)
152          ASSIGN(HEAD(r_true)[i], real_D, divtemp, $1_type)
153          TAIL(r_true)[i]=0.0;
154          ASSIGN(xtemp2[i], $1_type, divtemp, $1_type)
155          break;
156      }
157      case blas_prec_double:
158      case blas_prec_indigenous:
159      {
160  ifelse(`$1', `s',
161          `DECLARE(multemp, real_D)
162          DECLARE(divtemp, real_D)
163
164          MUL(multemp, real_D, x[i], $1_type, *alpha, $1_type)
165          DIV(divtemp, real_D, multemp, $1_type, Tii, $2_type)
166          ASSIGN(HEAD(r_true)[i], real_D, divtemp, real_D)
167          TAIL(r_true)[i]=0.0;',
168         `$1', `d',
169         `DECLARE(multemp, $1_type)
170          DECLARE(divtemp, $1_type)
171
172          MUL(multemp, $1_type, x[i], $1_type, *alpha, $1_type)
173          DIV(divtemp, $1_type, multemp, $1_type, Tii, $2_type)
174          ASSIGN(HEAD(r_true)[i], real_D, divtemp, $1_type)
175          TAIL(r_true)[i]=0.0;
176          ASSIGN(xtemp2[i], $1_type, divtemp, $1_type)')
177          break;
178      }
179      case blas_prec_extra:
180      {
181          DECLARE(multemp, real_E)
182          DECLARE(divtemp, real_E)
183
184          MUL(multemp, real_E, x[i], $1_type, *alpha, $1_type)
185          DIV(divtemp, real_E, multemp, real_E, Tii, $2_type)
186          ASSIGN(HEAD(r_true)[i], real_D, HEAD(divtemp), real_D)
187          ASSIGN(TAIL(r_true)[i], real_D, TAIL(divtemp), real_D)
188          break;
189      }
190      } /* case */
191    } /* if */
192  } /* for */
193
194  for(j=0; j<n; j++){
195    SET_ZERO_VECTOR_ELEMENT(temp, j, $2_type)
196  }
197
198  SET_VECTOR_ELEMENT(T, row*lda+row, 1.0, $2_type)
199
200  if ((uplo==blas_lower && trans==blas_no_trans) ||
201      (uplo==blas_upper && trans!=blas_no_trans)){
202     length = row;
203     start  = 0;
204  }
205  else{
206     length = n-row-1;
207     start  = row+1;
208  }
209
210  if (length != 0){
211
212ifelse(`$1', `$2', `
213     switch (prec){
214     case blas_prec_single: BLAS_$1dot_testgen(length, 0, length, norm,
215                                blas_no_conj, &minus_one, 1, alpha, 1,
216                                &xtemp2[start], temp, seed, &x[row],
217                                &HEAD(r_true)[row], &TAIL(r_true)[row]);
218                            break;
219     case blas_prec_double:
220     case blas_prec_indigenous:
221     case blas_prec_extra:  BLAS_$1dot_x_testgen(length,0, length, norm,
222                                blas_no_conj, &minus_one, 1, alpha, 1,
223                                &HEAD(r_true)[start], &TAIL(r_true)[start], temp,
224                                seed, &x[row], &HEAD(r_true)[row], &TAIL(r_true)[row]);
225                            break;
226     }',
227     `$1&&$2', `d&&s',
228`    switch (prec){
229     case blas_prec_single:
230     case blas_prec_double:
231     case blas_prec_indigenous:
232       /*BLAS_ddot_s_x_testgen(length, 0, length, norm,
233                                blas_no_conj, &minus_one, 1, alpha, 1,
234                                &HEAD(r_true)[start], &TAIL(r_true)[start], temp,
235                                seed, &x[row], &HEAD(r_true)[row], &TAIL(r_true)[row]);
236                            break;*/
237     case blas_prec_extra: BLAS_ddot_s_x_testgen(length,0, length, norm,
238                                blas_no_conj, &minus_one, 1, alpha, 1,
239                                &HEAD(r_true)[start], &TAIL(r_true)[start], temp,
240                                seed, &x[row], &HEAD(r_true)[row], &TAIL(r_true)[row]);
241                            break;
242     }')
243    $2trsv_commit(order, uplo, trans, length, T, lda, temp, row);
244  }
245  else{
246    x[row] = xrand(seed);
247
248    switch(prec){
249    case blas_prec_single:
250    {
251      DECLARE(multemp, $1_type)
252
253      MUL(multemp, $1_type, x[row], $1_type, *alpha, $1_type)
254      HEAD(r_true)[row]=multemp;
255      TAIL(r_true)[row]=0.0;
256      break;
257    }
258    case blas_prec_indigenous:
259    case blas_prec_double:
260    {
261ifelse(`$1', `s',
262     `DECLARE(multemp, real_D)
263
264      MUL(multemp, real_D, x[row], $1_type, *alpha, $1_type)
265      HEAD(r_true)[row]=multemp;
266      TAIL(r_true)[row]=0.0;',
267      `$1', `d',
268      `DECLARE(multemp, $1_type)
269
270      MUL(multemp, $1_type, x[row], $1_type, *alpha, $1_type)
271      HEAD(r_true)[row]=multemp;
272      TAIL(r_true)[row]=0.0;')
273      break;
274    }
275    case blas_prec_extra:
276    {
277      DECLARE(multemp, real_E)
278
279      MUL(multemp, real_E, x[row], $1_type, *alpha, $1_type)
280      ASSIGN(HEAD(r_true)[row], real_D, HEAD(multemp), real_D)
281      ASSIGN(TAIL(r_true)[row], real_D, TAIL(multemp), real_D)
282      break;
283    }
284    }
285  }
286
287  FREE_VECTOR(temp, $2_type)
288
289  if (prec!=blas_prec_extra)
290    FREE_VECTOR(xtemp2, $1_type)
291}')dnl
292dnl
293dnl
294dnl ---------------------------------------------------------------------
295dnl Usage: DOT_TRSV_NAME(abr_typeltr, x_typeltr, y_typeltr)
296dnl        produce dot_testgen name
297dnl ---------------------------------------------------------------------
298define(`DOT_TESTGEN_X_NAME', `ifelse(
299        `$1&&$2', `$1&&$1', `BLAS_$1dot_x_testgen',
300        `BLAS_$1dot_$2_x_testgen')')dnl
301dnl
302dnl
303define(`TRSV_TESTGEN_PURE_COMPLEX_BODY',
304`{
305  PTR_CAST(x, $1_type)
306  PTR_CAST(alpha, $1_type)
307  PTR_CAST(T, $2_type)
308  DECLARE(alpha_r, REAL_TYPE($1_type))
309  DECLARE_VECTOR(T_r, REAL_TYPE($2_type))
310  DECLARE_VECTOR(x_r, REAL_TYPE($1_type))
311  DECLARE_VECTOR(r_true_r, real_E)
312  int i, inc=2, length;
313
314  MALLOC_VECTOR(T_r, REAL_TYPE($2_type), 4*n*n)
315  MALLOC_VECTOR(x_r, REAL_TYPE($1_type), n)
316  MALLOC_VECTOR(r_true_r, real_E, n)
317
318  if (alpha_flag == 1){
319    alpha_r = alpha_i[0];
320  }
321
322  if ((uplo==blas_lower && trans==blas_no_trans) ||
323      (uplo==blas_upper && trans!=blas_no_trans)) {
324    length = row;
325  } else {
326    length = n-row-1;
327  }
328
329  REAL_TRSV_NAME($1, $2)(norm, order, uplo, trans, diag, n, &alpha_r,
330        alpha_flag, T_r, lda, x_r, seed, HEAD(r_true_r), TAIL(r_true_r),
331        row, prec);
332
333  alpha_i[0] = alpha_r;
334  alpha_i[1] = alpha_r;
335
336  if (diag == blas_non_unit_diag){
337    for(i=0; i<n; i++){
338      x_i[i*inc] = 0.0;
339      x_i[i*inc+1] = x_r[i];
340
341      if (i != row){
342        HEAD(r_true)[i*inc] = 0.0;
343        HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i];
344        TAIL(r_true)[i*inc] = 0.0;
345        TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i];
346      }
347      else{
348        HEAD(r_true)[i*inc] = -HEAD(r_true_r)[i];
349        HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i];
350        TAIL(r_true)[i*inc] = -TAIL(r_true_r)[i];
351        TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i];
352      }
353    }
354
355    for(i=0; i<4*n*n; i++){
356      T_i[i*inc] = T_r[i];
357
358      if (trans != blas_conj_trans)
359        T_i[i*inc+1] = T_r[i];
360      else
361        T_i[i*inc+1] = -T_r[i];
362    }
363
364    T_i[(row+lda*row)*inc+1] = 0.0;
365  } else {
366    for(i=0; i<n; i++){
367      x_i[i*inc] = 0.0;
368      x_i[i*inc+1] = x_r[i];
369
370      if (i != row || length == 0){
371        HEAD(r_true)[i*inc] = -HEAD(r_true_r)[i];
372        HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i];
373        TAIL(r_true)[i*inc] = -TAIL(r_true_r)[i];
374        TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i];
375      }
376      else{
377        x_i[i*inc] = x_r[i];
378        x_i[i*inc+1] = x_r[i];
379
380        HEAD(r_true)[i*inc] = 0.0;
381        HEAD(r_true)[i*inc+1] = 2*HEAD(r_true_r)[i];
382        TAIL(r_true)[i*inc] = 0.0;
383        TAIL(r_true)[i*inc+1] = 2*TAIL(r_true_r)[i];
384      }
385    }
386
387    for(i=0; i<4*n*n; i++){
388      T_i[i*inc] = T_r[i];
389
390      if (trans != blas_conj_trans)
391        T_i[i*inc+1] = -T_r[i];
392      else
393        T_i[i*inc+1] = T_r[i];
394    }
395
396    for(i=0; i<n; i++){
397      T_i[(i+lda*i)*inc+1] = 0.0;
398    }
399  }
400
401  FREE_VECTOR(T_r, REAL_TYPE($2_type))
402  FREE_VECTOR(x_r, REAL_TYPE($1_type))
403  FREE_VECTOR(HEAD(r_true_r), real_D)
404  FREE_VECTOR(TAIL(r_true_r), real_D)
405}')dnl
406dnl
407dnl
408dnl
409define(`TRSV_TESTGEN_MIX_COMPLEX_BODY',
410`{
411  PTR_CAST(x, $1_type)
412  PTR_CAST(alpha, $1_type)
413  PTR_CAST(T, $2_type)
414  DECLARE(alpha_r, REAL_TYPE($1_type))
415  DECLARE_VECTOR(x_r, REAL_TYPE($1_type))
416  double *HEAD(r_true_r), *TAIL(r_true_r);
417  int i, inc=2;
418
419  MALLOC_VECTOR(x_r, REAL_TYPE($1_type), n)
420  MALLOC_VECTOR(HEAD(r_true_r), real_D, n)
421  MALLOC_VECTOR(TAIL(r_true_r), real_D, n)
422
423  if (alpha_flag == 1){
424    alpha_r = alpha_i[0];
425  }
426
427  REAL_TRSV_NAME($1, $2)(norm, order, uplo, trans, diag, n, &alpha_r,
428        alpha_flag, T_i, lda, x_r, seed, HEAD(r_true_r), TAIL(r_true_r),
429        row, prec);
430
431  alpha_i[0] = alpha_r;
432  alpha_i[1] = alpha_r;
433
434  for(i=0; i<n; i++){
435    x_i[i*inc] = 0.0;
436    x_i[i*inc+1] = x_r[i];
437
438    HEAD(r_true)[i*inc] = -HEAD(r_true_r)[i];
439    HEAD(r_true)[i*inc+1] = HEAD(r_true_r)[i];
440    TAIL(r_true)[i*inc] = -TAIL(r_true_r)[i];
441    TAIL(r_true)[i*inc+1] = TAIL(r_true_r)[i];
442  }
443
444  FREE_VECTOR(x_r, REAL_TYPE($1_type))
445  FREE_VECTOR(HEAD(r_true_r), real_D)
446  FREE_VECTOR(TAIL(r_true_r), real_D)
447}')dnl
448dnl
449dnl
450define(`REAL_TRSV_NAME', `ifelse(
451        `$1&&$2', `c&&c', `BLAS_strsv_testgen',
452        `$1&&$2', `z&&z', `BLAS_dtrsv_testgen',
453        `$1&&$2', `z&&c', `BLAS_dtrsv_s_testgen',
454        `$1&&$2', `c&&s', `BLAS_strsv_testgen',
455        `$1&&$2', `z&&d', `BLAS_dtrsv_testgen')')dnl
456dnl
457dnl
458define(`PROTOTYPES', `dnl
459TRSV_TESTGEN_HEAD(s, s);
460TRSV_TESTGEN_HEAD(d, d);
461TRSV_TESTGEN_HEAD(d, s);
462TRSV_TESTGEN_HEAD(c, c);
463TRSV_TESTGEN_HEAD(z, c);
464TRSV_TESTGEN_HEAD(z, z);
465TRSV_TESTGEN_HEAD(c, s);
466TRSV_TESTGEN_HEAD(z, d);
467')dnl
468dnl
469dnl
470define(`SOURCE', `dnl
471#include "blas_extended.h"
472#include "blas_extended_private.h"
473#include "blas_extended_test.h"
474
475TRSV_TESTGEN(s, s)
476TRSV_TESTGEN(d, d)
477TRSV_TESTGEN(d, s)
478TRSV_TESTGEN(c, c)
479TRSV_TESTGEN(z, c)
480TRSV_TESTGEN(z, z)
481TRSV_TESTGEN(c, s)
482TRSV_TESTGEN(z, d)
483')dnl
484dnl
485dnl
486ifdef(`prototypes_only', `PROTOTYPES()', `SOURCE()')dnl
487dnl
488dnl
489