1dnl **********************************************************************
2dnl Perform x = alpha * inverse(T) * x
3dnl **********************************************************************
4dnl
5#include <math.h>
6#include "blas_extended.h"
7#include "blas_extended_private.h"
8include(cblas.m4)dnl
9include(trsv-common.m4)dnl
10dnl
11dnl
12dnl ----------------------------------------------------------------------
13dnl Usage: TRSV_COMMENT(ax_typeltr, T_typeltr, _x)
14dnl        ... generate the leading comment for the TRSV routine
15dnl ----------------------------------------------------------------------
16dnl
17define(`TRSV_COMMENT',`
18/*
19 * Purpose
20 * =======
21 *
22 * This routine solve :
23 *
24 *     x <- alpha * inverse(T) * x
25 *
26 * Arguments
27 * =========
28 *
29 * order  (input) enum blas_order_type
30 *        column major, row major
31 *
32 * uplo   (input) enum blas_uplo_type
33 *        upper, lower
34 *
35 * trans  (input) enum blas_trans_type
36 *        no trans, trans, conj trans
37 *
38 * diag   (input) enum blas_diag_type
39 *        unit, non unit
40 *
41 * n      (input) int
42 *        the dimension of T
43 *
44 * alpha  (input) $1_scalar
45 *
46 * T      (input) $2_array
47 *        Triangular matrix
48 *
49 * x      (input) const $1_array
50 *           Array of length n.
51 *
52 * incx   (input) int
53 *           The stride used to access components x[i].
54 *
55PREC_COMMENT($3)dnl
56 */')dnl
57dnl
58dnl
59dnl
60dnl --------------------------------------------------------------------
61dnl Usage: TRSV_INIT(ax_typeltr, T_typeltr, _x)
62dnl        declare trsv local variables, and check inputs
63dnl --------------------------------------------------------------------
64dnl
65define(`TRSV_INIT',
66` int i, j; /* used to idx matrix */
67   int ix, jx; /* used to idx vector x */
68   int start_x; /* used as the starting idx to vector x */
69   PTR_CAST(T, $2_type, `const') /* internal matrix T */
70   PTR_CAST(x, $1_type, `')      /* internal x */
71   SCALAR_CAST(alpha, $1_type) /* internal alpha */
72   DECLARE(T_element, $2_type) /* temporary variable for an element of matrix A */
73   int incT=1; /* internal ldt */
74
75   if ((order != blas_rowmajor && order != blas_colmajor) ||
76       (uplo != blas_upper && uplo != blas_lower) ||
77       (trans != blas_trans && trans !=
78        blas_no_trans && trans != blas_conj_trans) ||
79       (diag != blas_non_unit_diag && diag != blas_unit_diag) ||
80       (ldt < n) ||
81       (incx == 0)){
82     BLAS_error(routine_name, 0, 0, NULL);
83   }
84
85   if (n <= 0) return;
86
87   INC_ADJUST(incT, $2_type)
88   INC_ADJUST(incx, $1_type)
89   /* configuring the vector starting idx */
90   if (incx <= 0) { start_x = -(n-1)*incx; }
91   else { start_x = 0; }
92
93   /* if alpha is zero, then return x as a zero vector */
94   if (TEST_0(alpha_i, $1_type)) {
95     ix = start_x;
96     for(i=0; i<n; i++) {
97        SET_ZERO_VECTOR_ELEMENT(x_i, ix, $1_type)
98        ix += incx;
99     }
100     return;
101   }')dnl
102dnl
103dnl
104dnl --------------------------------------------------------------------
105dnl Usage: TRSV1(ax_typeltr, T_typeltr, internal_prec )
106dnl        ... x = alpha * transpose(T) * x
107dnl        ... x = alpha * transpose(inverse(T)) * x
108dnl
109dnl        Each type and precision can be one of
110dnl                 real_S ... real, single precision
111dnl                 real_D ... real, double precision
112dnl                 real_I ... real, indigenous precision
113dnl                 real_E ... real, extra precision
114dnl              complex_S ... complex, single precision
115dnl              complex_D ... complex, double precision
116dnl              complex_I ... complex, indigenous precision
117dnl              complex_E ... complex, extra precision
118dnl
119dnl       temp1, temp2:    temp scalar that holds an entry in array x.
120dnl       adjust_row: adjusts the row index into matrix a
121dnl       adjust_col: adjusts the coloumn index into matrix a
122dnl --------------------------------------------------------------------
123dnl
124define(`TRSV1', `
125  {
126    DECLARE(temp1, $3) /* temporary variable for calculations */
127    DECLARE(temp2, $3) /* temporary variable for calculations */
128    DECLARE(temp3, $3) /* temporary variable for calculations */
129
130    if ((order == blas_rowmajor &&
131         trans == blas_no_trans && uplo == blas_upper) ||
132        (order == blas_colmajor &&
133         trans != blas_no_trans && uplo == blas_lower)) {
134      TRSV1_CONJ_TRANS_BACKWARD($2, $3, $1, i, j)
135    } else if ((order == blas_rowmajor &&
136                trans == blas_no_trans && uplo == blas_lower) ||
137               (order == blas_colmajor &&
138                trans != blas_no_trans && uplo == blas_upper)) {
139      TRSV1_CONJ_TRANS_FORWARD($2, $3, $1, i, j)
140    } else if ((order == blas_rowmajor &&
141                trans != blas_no_trans && uplo == blas_lower) ||
142               (order == blas_colmajor &&
143                trans == blas_no_trans && uplo == blas_upper)) {
144      TRSV1_CONJ_TRANS_BACKWARD($2, $3, $1, j, i)
145    } else if ((order == blas_rowmajor &&
146                trans != blas_no_trans && uplo == blas_upper) ||
147               (order == blas_colmajor &&
148                trans == blas_no_trans && uplo == blas_lower)) {
149      TRSV1_CONJ_TRANS_FORWARD($2, $3, $1, j, i)
150    }
151  }')dnl
152dnl
153dnl
154dnl
155dnl --------------------------------------------------------------------
156dnl Usage: TRSV2(ax_typeltr, T_typeltr, internal_prec )
157dnl
158dnl        *************************************************************
159dnl        NOTE: The only difference between TRSV1 and TRSV2 is that
160dnl              TRSV2 dynamically allocates a vector of type
161dnl              internal_prec used as an intermediary for computing x,
162dnl              so as to keep any intermediate computations in
163dnl              internal_prec accuracy.
164dnl        *************************************************************
165dnl
166dnl        ... x = alpha * transpose(T) * x
167dnl        ... x = alpha * transpose(inverse(T)) * x
168dnl
169dnl        Each type and precision can be one of
170dnl                 real_S ... real, single precision
171dnl                 real_D ... real, double precision
172dnl                 real_I ... real, indigenous precision
173dnl                 real_E ... real, extra precision
174dnl              complex_S ... complex, single precision
175dnl              complex_D ... complex, double precision
176dnl              complex_I ... complex, indigenous precision
177dnl              complex_E ... complex, extra precision
178dnl
179dnl       temp1, temp2:    temp scalar that holds an entry in array x.
180dnl       adjust_row: adjusts the row index into matrix a
181dnl       adjust_col: adjusts the coloumn index into matrix a
182dnl --------------------------------------------------------------------
183dnl
184define(`TRSV2', `
185  {
186    int inc_intx; /* inc for intx */
187    DECLARE(temp1, $3) /* temporary variable for calculations */
188    DECLARE(temp2, $3) /* temporary variable for calculations */
189    DECLARE(temp3, $3) /* temporary variable for calculations */
190    DECLARE_VECTOR(intx, $3) /* copy of x used for calculations */
191
192    /* allocate space for intx */
193    MALLOC_VECTOR(intx, $3, n)
194
195    /* since intx is for internal usage, set it to 1 and then adjust
196       it if necessary */
197    inc_intx = 1;
198    INC_ADJUST(inc_intx, $1)
199
200    /* copy x to intx */
201    ix=start_x;
202    jx=0;
203    for (i=0; i<n; i++){
204      GET_ARRAY_ELEMENT(temp1, $3, x_i, $1, ix)
205      SET_ARRAY_ELEMENT(temp1, $3, intx, $3, jx)
206      ix+=incx;
207      jx+=inc_intx;
208    }
209
210    if ((order == blas_rowmajor &&
211         trans == blas_no_trans && uplo == blas_upper) ||
212        (order == blas_colmajor &&
213         trans != blas_no_trans && uplo == blas_lower)) {
214      TRSV2_CONJ_TRANS_BACKWARD($2, $3, $1, i, j)
215    } else if ((order == blas_rowmajor &&
216                trans == blas_no_trans && uplo == blas_lower) ||
217               (order == blas_colmajor &&
218                trans != blas_no_trans && uplo == blas_upper)) {
219      TRSV2_CONJ_TRANS_FORWARD($2, $3, $1, i, j)
220    } else if ((order == blas_rowmajor &&
221                trans != blas_no_trans && uplo == blas_lower) ||
222               (order == blas_colmajor &&
223                trans == blas_no_trans && uplo == blas_upper)) {
224      TRSV2_CONJ_TRANS_BACKWARD($2, $3, $1, j, i)
225    } else if ((order == blas_rowmajor &&
226                trans != blas_no_trans && uplo == blas_upper) ||
227               (order == blas_colmajor &&
228                trans == blas_no_trans && uplo == blas_lower)) {
229      TRSV2_CONJ_TRANS_FORWARD($2, $3, $1, j, i)
230    }
231
232    /* copy the final results from intx to x */
233    ix=start_x;
234    jx=0;
235    for (i=0; i<n; i++){
236      GET_ARRAY_ELEMENT(temp1, $3, intx, $3, jx)
237      SET_ROUND_VECTOR_ELEMENT(x_i, ix, temp1, $3)
238      ix+=incx;
239      jx+=inc_intx;
240    }
241
242    FREE_VECTOR(intx, $3)
243  }')dnl
244dnl
245dnl
246dnl -----------------------------------------------------------------------
247dnl Usage: TRSV1_CONJ_TRANS_BACKWARD(T_typeltr, internal_prec, x_typeltr, col, row)
248dnl        If the matrix type is complex, then allow blas_conj_trans option
249dnl -----------------------------------------------------------------------
250dnl
251define(`TRSV1_CONJ_TRANS_BACKWARD',`ifelse(
252  `$1', `complex_S',
253  `if (trans == blas_conj_trans) {
254     TRSV1_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
255   } else {
256     TRSV1_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
257   }',
258  `$1', `complex_D',
259  `if (trans == blas_conj_trans) {
260     TRSV1_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
261   } else {
262     TRSV1_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
263   }',
264  `TRSV1_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)')')dnl
265dnl
266dnl
267dnl -----------------------------------------------------------------------
268dnl Usage: TRSV1_CONJ_TRANS_FORWARD(T_typeltr, internal_prec, x_typeltr, col, row)
269dnl        If the matrix type is complex, then allow blas_conj_trans option
270dnl -----------------------------------------------------------------------
271dnl
272define(`TRSV1_CONJ_TRANS_FORWARD',`ifelse(
273  `$1', `complex_S',
274  `if (trans == blas_conj_trans) {
275     TRSV1_FORWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
276   } else {
277     TRSV1_FORWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
278   }',
279  `$1', `complex_D',
280  `if (trans == blas_conj_trans) {
281     TRSV1_FORWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
282   } else {
283     TRSV1_FORWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
284   }',
285  `TRSV1_FORWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)')')dnl
286dnl
287dnl
288dnl -----------------------------------------------------------------------
289dnl Usage: TRSV2_CONJ_TRANS_BACKWARD(a_type, internal_prec, x_type, col, row)
290dnl        If the matrix type is complex, then allow blas_conj_trans option
291dnl -----------------------------------------------------------------------
292dnl
293define(`TRSV2_CONJ_TRANS_BACKWARD',`ifelse(
294  `$1', `complex_S',
295  `if (trans == blas_conj_trans) {
296     TRSV2_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
297   } else {
298     TRSV2_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
299   }',
300  `$1', `complex_D',
301  `if (trans == blas_conj_trans) {
302     TRSV2_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
303   } else {
304     TRSV2_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
305   }',
306  `TRSV2_BACKWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)')')dnl
307dnl
308dnl
309dnl -----------------------------------------------------------------------
310dnl Usage: TRSV2_CONJ_TRANS_FORWARD(a_type, internal_prec, x_type, col, row)
311dnl        If the matrix type is complex, then allow blas_conj_trans option
312dnl -----------------------------------------------------------------------
313dnl
314define(`TRSV2_CONJ_TRANS_FORWARD',`ifelse(
315  `$1', `complex_S',
316  `if (trans == blas_conj_trans) {
317     TRSV2_FORWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
318   } else {
319     TRSV2_FORWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
320   }',
321  `$1', `complex_D',
322  `if (trans == blas_conj_trans) {
323     TRSV2_FORWARD_SUBST($1, $2, $3, $4, $5, blas_conj)
324   } else {
325     TRSV2_FORWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)
326   }',
327  `TRSV2_FORWARD_SUBST($1, $2, $3, $4, $5, blas_no_conj)')')dnl
328dnl
329dnl
330dnl
331dnl ---------------------------------------------------------------------
332dnl Usage: TRSV1_BACKWARD_SUBST(T_typeltr, internal_prec, x_typeltr, col, row, conj)
333dnl        perform backward substitution to compute
334dnl                  x = alpha * inverse(T) * x
335dnl
336dnl        col and row are used to index a matrix element.
337dnl        The possible pairs of (col, row) values are (i, j) or (j, i)
338dnl
339dnl        TRSV1_BACKWARD_SUBST is used by a matrix of type:
340dnl        1. blas_rowmajor, blas_no_trans, blas_upper             (i, j)
341dnl        2. blas_colmajor, blas_trans/blas_conj_trans, blas_lower(i, j)
342dnl        3. blas_rowmajor, blas_trans/blas_conj_trans, blas_lower(j, i)
343dnl        4. blas_colmajor, blas_no_trans, blas_upper             (j, i)
344dnl ---------------------------------------------------------------------
345define(`TRSV1_BACKWARD_SUBST', `
346  jx = start_x+(n-1)*incx;
347  for(j=n-1; j>=0; j--) {
348
349  /* compute Xj = alpha*Xj - SUM Tij(or Tji) * Xi
350                        i=j+1 to n-1           */
351  GET_ARRAY_ELEMENT(temp3, $2, x_i, $3, jx)
352  MUL(temp1, $2, temp3, $2, alpha_i, $3)
353
354  ix=start_x+(n-1)*incx;
355  for (i=n-1; i>=j+1; i--) {
356    GET_MATRIX_ELEMENT(T_element, T_i, $4*incT, $5, ldt*incT, $1)
357    CONJ(T_element, $1, $6)
358    GET_ARRAY_ELEMENT(temp3, $2, x_i, $3, ix)
359    MUL(temp2, $2, temp3, $2, T_element, $1)
360    SUB(temp1, $2, temp1, $2, temp2, $2)
361    ix -= incx;
362  } /* for j<n */
363
364  /* if the diagonal entry is not equal to one, then divide Xj by
365     the entry */
366  if (diag == blas_non_unit_diag) {
367    GET_MATRIX_ELEMENT(T_element, T_i, j*incT, j, ldt*incT, $1)
368    CONJ(T_element, $1, $6)
369
370    DIV(temp1, $2, temp1, $2, T_element, $1)
371
372  } /* if (diag == blas_non_unit_diag) */
373
374  SET_ROUND_VECTOR_ELEMENT(x_i, jx, temp1, $2)
375
376  jx -= incx;
377} /* for j>=0 */')dnl
378dnl
379dnl
380dnl
381dnl ---------------------------------------------------------------------
382dnl Usage: TRSV2_BACKWARD_SUBST(T_typeltr, internal_prec, x_typeltr, col, row, conj)
383dnl        perform backward substitution to compute
384dnl                  x = alpha * inverse(T) * x
385dnl
386dnl        col and row are used to index a matrix element.
387dnl        The possible pairs of (col, row) values are (i, j) or (j, i)
388dnl
389dnl        TRSV2_BACKWARD_SUBST is used by a matrix of type:
390dnl        1. blas_rowmajor, blas_no_trans, blas_upper             (i, j)
391dnl        2. blas_colmajor, blas_trans/blas_conj_trans, blas_lower(i, j)
392dnl        3. blas_rowmajor, blas_trans/blas_conj_trans, blas_lower(j, i)
393dnl        4. blas_colmajor, blas_no_trans, blas_upper             (j, i)
394dnl ---------------------------------------------------------------------
395define(`TRSV2_BACKWARD_SUBST', `
396  jx = (n-1)*inc_intx;
397  for(j=n-1; j>=0; j--) {
398
399  /* compute Xj = alpha*Xj - SUM Aij(or Aji) * Xi
400                       i=j+1 to n-1           */
401  GET_ARRAY_ELEMENT(temp3, $2, intx, $2, jx)
402  /* multiply by alpha */
403  MUL(temp1, $2, temp3, $2, alpha_i, $3)
404
405  ix=(n-1)*inc_intx;
406  for (i=n-1; i>=j+1; i--) {
407    GET_MATRIX_ELEMENT(T_element, T_i, $4*incT, $5, ldt*incT, $1)
408    CONJ(T_element, $1, $6)
409    GET_ARRAY_ELEMENT(temp3, $2, intx, $2, ix)
410    MUL(temp2, $2, temp3, $2, T_element, $1)
411    SUB(temp1, $2, temp1, $2, temp2, $2)
412    ix -= inc_intx;
413  } /* for j<n */
414
415  /* if the diagonal entry is not equal to one, then divide Xj by
416     the entry */
417  if (diag == blas_non_unit_diag) {
418    GET_MATRIX_ELEMENT(T_element, T_i, j*incT, j, ldt*incT, $1)
419    CONJ(T_element, $1, $6)
420
421    DIV(temp1, $2, temp1, $2, T_element, $1)
422
423  } /* if (diag == blas_non_unit_diag) */
424
425  SET_ARRAY_ELEMENT(temp1, $2, intx, $2, jx)
426
427  jx -= inc_intx;
428} /* for j>=0 */')dnl
429dnl
430dnl
431dnl ---------------------------------------------------------------------
432dnl Usage: TRSV1_FORWARD_SUBST(T_typeltr, internal_prec, x_typeltr, col, row)
433dnl        perform forward substitution to compute
434dnl                  x = alpha * inverse(T) * x
435dnl
436dnl        col and row are used to index a matrix element.
437dnl        The possible pairs of (col, row) values are (i, j) or (j, i)
438dnl
439dnl        TRSV1_FORWARD_SUBST is used by a matrix of type:
440dnl        1. blas_rowmajor, blas_no_trans, blas_lower             (i, j)
441dnl        2. blas_colmajor, blas_trans/blas_conj_trans, blas_upper(i, j)
442dnl        3. blas_rowmajor, blas_trans/blas_conj_trans, blas_upper(j, i)
443dnl        4. blas_colmajor, blas_no_trans, blas_lower             (j, i)
444dnl ---------------------------------------------------------------------
445define(`TRSV1_FORWARD_SUBST', `
446  jx = start_x;
447  for(j=0; j<n; j++){
448
449  /* compute Xj = alpha*Xj - SUM Aij(or Aji) * Xi
450                       i=j+1 to n-1           */
451  GET_ARRAY_ELEMENT(temp3, $2, x_i, $3, jx)
452  /* multiply by alpha */
453  MUL(temp1, $2, temp3, $2, alpha_i, $3)
454
455  ix = start_x;
456  for (i=0; i<j; i++) {
457    GET_MATRIX_ELEMENT(T_element, T_i, $4*incT, $5, ldt*incT, $1)
458    CONJ(T_element, $1, $6)
459    GET_ARRAY_ELEMENT(temp3, $2, x_i, $3, ix)
460    MUL(temp2, $2, temp3, $2, T_element, $1)
461    SUB(temp1, $2, temp1, $2, temp2, $2)
462    ix += incx;
463  } /* for i<j */
464
465  /* if the diagonal entry is not equal to one, then divide Xj by
466     the entry */
467  if (diag == blas_non_unit_diag) {
468    GET_MATRIX_ELEMENT(T_element, T_i, j*incT, j, ldt*incT, $1)
469    CONJ(T_element, $1, $6)
470
471    DIV(temp1, $2, temp1, $2, T_element, $1)
472
473  } /* if (diag == blas_non_unit_diag) */
474
475  SET_ROUND_VECTOR_ELEMENT(x_i, jx, temp1, $2)
476  jx += incx;
477} /* for j<n */')dnl
478dnl
479dnl
480dnl
481dnl ---------------------------------------------------------------------
482dnl Usage: TRSV2_FORWARD_SUBST(T_typeltr, internal_prec, ax_typeltr, col, row)
483dnl        perform forward substitution to compute
484dnl                  x = alpha * inverse(T) * x
485dnl
486dnl        col and row are used to index a matrix element.
487dnl        The possible pairs of (col, row) values are (i, j) or (j, i)
488dnl
489dnl        TRSV2_FORWARD_SUBST is used by a matrix of type:
490dnl        1. blas_rowmajor, blas_no_trans, blas_lower             (i, j)
491dnl        2. blas_colmajor, blas_trans/blas_conj_trans, blas_upper(i, j)
492dnl        3. blas_rowmajor, blas_trans/blas_conj_trans, blas_upper(j, i)
493dnl        4. blas_colmajor, blas_no_trans, blas_lower             (j, i)
494dnl ---------------------------------------------------------------------
495define(`TRSV2_FORWARD_SUBST', `
496  jx = 0;
497  for(j=0; j<n; j++){
498
499    /* compute Xj = Xj - SUM Aij(or Aji) * Xi
500                         i=j+1 to n-1           */
501    GET_ARRAY_ELEMENT(temp3, $2, intx, $2, jx)
502    /* multiply by alpha */
503    MUL(temp1, $2, temp3, $2, alpha_i, $3)
504
505    ix = 0;
506    for (i=0; i<j; i++) {
507      GET_MATRIX_ELEMENT(T_element, T_i, $4*incT, $5, ldt*incT, $1)
508      CONJ(T_element, $1, $6)
509      GET_ARRAY_ELEMENT(temp3, $2, intx, $2, ix)
510      MUL(temp2, $2, temp3, $2, T_element, $1)
511      SUB(temp1, $2, temp1, $2, temp2, $2)
512      ix += inc_intx;
513    } /* for i<j */
514
515    /* if the diagonal entry is not equal to one, then divide Xj by
516       the entry */
517    if (diag == blas_non_unit_diag) {
518      GET_MATRIX_ELEMENT(T_element, T_i, j*incT, j, ldt*incT, $1)
519      CONJ(T_element, $1, $6)
520
521      DIV(temp1, $2, temp1, $2, T_element, $1)
522
523    } /* if (diag == blas_non_unit_diag) */
524
525    SET_ARRAY_ELEMENT(temp1, $2, intx, $2, jx)
526    jx += inc_intx;
527  } /* for j<n */')dnl
528dnl
529dnl
530dnl
531dnl ----------------------------------------------------------------------
532dnl Usage: SWITCH_prec($1, $2, $3, $4, $5) ... generate
533dnl        $3 is the type of 'temp1' and 'temp2' in single case.
534dnl        $4 is the type of 'temp1' and 'temp2' in double/indigenous case.
535dnl        $5 is the type of 'temp1' and 'temp2' in extra case.
536dnl ----------------------------------------------------------------------
537dnl
538define(`SWITCH_prec',
539       `switch ( prec ) {
540dnl
541dnl $3 >= $1_type. Therefore,
542dnl if ($1_type == $3) then do not need to allocate memory,
543dnl so use TRSV1 instead of TRSV2
544dnl
545  case blas_prec_single: ifelse(`$3', `$4', `', `
546    ifelse(`$1', `$3', `TRSV1($1, $2, $3)', `TRSV2($1, $2, $3)')
547    break;
548  ')dnl
549dnl
550dnl likewise if ($1 == $4)
551dnl
552  case blas_prec_double:
553  case blas_prec_indigenous:
554    ifelse(`$1', `$4', `TRSV1($1, $2, $4)', `TRSV2($1, $2, $4)')
555    break;
556  case blas_prec_extra:
557dnl
558dnl since $5 > $1, use TRSV2
559dnl
560  { FPU_FIX_DECL; FPU_FIX_START;
561    { TRSV2($1, $2, $5) }
562    FPU_FIX_STOP; }
563  break;
564  }')dnl
565dnl
566dnl
567dnl
568dnl --------------------------------------------------------------------
569dnl Usage: TRSV_X_BODY(ax_prec, T_prec) ... dispatches
570dnl        TRSV with appropriate type and precision info of
571dnl        the specified internal prec.
572dnl --------------------------------------------------------------------
573dnl
574define(`TRSV_X_BODY',
575  `SWITCH_prec($1, $2,
576    TMP_TYPE_X($1, S), TMP_TYPE_X($1, D), TMP_TYPE_X($1, E))')dnl
577dnl
578dnl
579define(`TRSV_BODY',
580  `TRSV1($1, $2, $3)')dnl
581dnl
582dnl
583define(`TRSV', `
584  TRSV_HEAD($1, $2, $3)
585  TRSV_COMMENT($1, $2, $3)
586  {
587    char *routine_name = "TRSV_NAME($1, $2)";
588
589    TRSV_INIT($1, $2, $3)
590    ifelse($3, _x, `TRSV_X_BODY($1_type, $2_type)',
591      `TRSV_BODY($1_type, $2_type, $1_type)')
592  }
593')dnl
594dnl
595dnl
596