/
bakslv.c
105 lines (83 loc) · 3.08 KB
/
bakslv.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
/*
* R : A Computer Language for Statistical Data Analysis
* Copyright (C) 1997-1998 Robert Gentleman, Ross Ihaka and the
* R Development Core Team
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*/
/* ../appl/bakslv.f
-- translated by f2c (version of 1 June 1993 23:00:00).
-- and hand edited by Martin Maechler.
*/
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
#include "R_ext/Linpack.h"
#include "R_ext/Applic.h"
void bakslv(double *t, int *ldt, int *n,
double *b, int *ldb, int *nb,
double *x, int *job, int *info)
{
/* bakslv is a subroutine to solve triangular systems of
* the form
* t * x = b
* or
* t' * x = b [ t' := transpose(t) ]
* where t is a triangular matrix of order n.
* The subroutine handles the multiple right-hand side case.
* It is really just a wrapper for the linpack subroutine dtrsl.
* on entry
* t double (ldt,n'). n' >= n (below)
* t[] contains the coefficient matrix of the system
* to be solved. only the elements above or below
* the diagonal are referenced.
* ldt int; ldt is the leading dimension of the array t.
* n int; n is the order of the system. n <= min(ldt,ldb)
* b double (ldb,nb'). nb' >= nb (below)
* b[] contains the right hand side(s) of the system.
* ldb int; ldb is the leading dimension of the array b.
* nb int; the number of right hand sides of the system.
* job int; job specifies what kind of system is to be solved.
*
* if job is
*
* 00 solve t * x = b, t lower triangular,
* 01 solve t * x = b, t upper triangular,
* 10 solve t' * x = b, t lower triangular,
* 11 solve t' * x = b, t upper triangular.
* on return
* x double precision(ldb, nb)
* contains the solution(s) if info == 0.
* info int
* info contains zero if the system is nonsingular.
* otherwise info contains the index of
* the first zero diagonal element of t.
* subroutines and functions
* linpack: dtrsl (t,ldt,n, b,job,info)
* blas: dcopy
*/
/* INTERNAL VARIABLES. */
static int c__1 = 1; /* constant */
int p, nn, j;
p = *nb;
nn = *ldb;
for (j = 0; j < p; ++j) {/* for each right-hand side */
F77_CALL(dcopy)(n, &b[j * nn], &c__1, &x[j * nn], &c__1);
F77_CALL(dtrsl)(t, ldt, n, &x[j * nn], job, info);
if (*info != 0) {
return;
}
}
}