LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
slsets.f
Go to the documentation of this file.
1 *> \brief \b SLSETS
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 * Definition:
9 * ===========
10 *
11 * SUBROUTINE SLSETS( M, P, N, A, AF, LDA, B, BF, LDB, C, CF,
12 * D, DF, X, WORK, LWORK, RWORK, RESULT )
13 *
14 * .. Scalar Arguments ..
15 * INTEGER LDA, LDB, LWORK, M, P, N
16 * ..
17 * .. Array Arguments ..
18 * REAL A( LDA, * ), AF( LDA, * ), B( LDB, * ),
19 * $ BF( LDB, * ), RESULT( 2 ), RWORK( * ),
20 * $ C( * ), D( * ), CF( * ), DF( * ),
21 * $ WORK( LWORK ), X( * )
22 *
23 *
24 *> \par Purpose:
25 * =============
26 *>
27 *> \verbatim
28 *>
29 *> SLSETS tests SGGLSE - a subroutine for solving linear equality
30 *> constrained least square problem (LSE).
31 *> \endverbatim
32 *
33 * Arguments:
34 * ==========
35 *
36 *> \param[in] M
37 *> \verbatim
38 *> M is INTEGER
39 *> The number of rows of the matrix A. M >= 0.
40 *> \endverbatim
41 *>
42 *> \param[in] P
43 *> \verbatim
44 *> P is INTEGER
45 *> The number of rows of the matrix B. P >= 0.
46 *> \endverbatim
47 *>
48 *> \param[in] N
49 *> \verbatim
50 *> N is INTEGER
51 *> The number of columns of the matrices A and B. N >= 0.
52 *> \endverbatim
53 *>
54 *> \param[in] A
55 *> \verbatim
56 *> A is REAL array, dimension (LDA,N)
57 *> The M-by-N matrix A.
58 *> \endverbatim
59 *>
60 *> \param[out] AF
61 *> \verbatim
62 *> AF is REAL array, dimension (LDA,N)
63 *> \endverbatim
64 *>
65 *> \param[in] LDA
66 *> \verbatim
67 *> LDA is INTEGER
68 *> The leading dimension of the arrays A, AF, Q and R.
69 *> LDA >= max(M,N).
70 *> \endverbatim
71 *>
72 *> \param[in] B
73 *> \verbatim
74 *> B is REAL array, dimension (LDB,N)
75 *> The P-by-N matrix A.
76 *> \endverbatim
77 *>
78 *> \param[out] BF
79 *> \verbatim
80 *> BF is REAL array, dimension (LDB,N)
81 *> \endverbatim
82 *>
83 *> \param[in] LDB
84 *> \verbatim
85 *> LDB is INTEGER
86 *> The leading dimension of the arrays B, BF, V and S.
87 *> LDB >= max(P,N).
88 *> \endverbatim
89 *>
90 *> \param[in] C
91 *> \verbatim
92 *> C is REAL array, dimension( M )
93 *> the vector C in the LSE problem.
94 *> \endverbatim
95 *>
96 *> \param[out] CF
97 *> \verbatim
98 *> CF is REAL array, dimension( M )
99 *> \endverbatim
100 *>
101 *> \param[in] D
102 *> \verbatim
103 *> D is REAL array, dimension( P )
104 *> the vector D in the LSE problem.
105 *> \endverbatim
106 *>
107 *> \param[out] DF
108 *> \verbatim
109 *> DF is REAL array, dimension( P )
110 *> \endverbatim
111 *>
112 *> \param[out] X
113 *> \verbatim
114 *> X is REAL array, dimension( N )
115 *> solution vector X in the LSE problem.
116 *> \endverbatim
117 *>
118 *> \param[out] WORK
119 *> \verbatim
120 *> WORK is REAL array, dimension (LWORK)
121 *> \endverbatim
122 *>
123 *> \param[in] LWORK
124 *> \verbatim
125 *> LWORK is INTEGER
126 *> The dimension of the array WORK.
127 *> \endverbatim
128 *>
129 *> \param[out] RWORK
130 *> \verbatim
131 *> RWORK is REAL array, dimension (M)
132 *> \endverbatim
133 *>
134 *> \param[out] RESULT
135 *> \verbatim
136 *> RESULT is REAL array, dimension (2)
137 *> The test ratios:
138 *> RESULT(1) = norm( A*x - c )/ norm(A)*norm(X)*EPS
139 *> RESULT(2) = norm( B*x - d )/ norm(B)*norm(X)*EPS
140 *> \endverbatim
141 *
142 * Authors:
143 * ========
144 *
145 *> \author Univ. of Tennessee
146 *> \author Univ. of California Berkeley
147 *> \author Univ. of Colorado Denver
148 *> \author NAG Ltd.
149 *
150 *> \date November 2011
151 *
152 *> \ingroup single_eig
153 *
154 * =====================================================================
155  SUBROUTINE slsets( M, P, N, A, AF, LDA, B, BF, LDB, C, CF,
156  $ d, df, x, work, lwork, rwork, result )
157 *
158 * -- LAPACK test routine (version 3.4.0) --
159 * -- LAPACK is a software package provided by Univ. of Tennessee, --
160 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
161 * November 2011
162 *
163 * .. Scalar Arguments ..
164  INTEGER lda, ldb, lwork, m, p, n
165 * ..
166 * .. Array Arguments ..
167  REAL a( lda, * ), af( lda, * ), b( ldb, * ),
168  $ bf( ldb, * ), result( 2 ), rwork( * ),
169  $ c( * ), d( * ), cf( * ), df( * ),
170  $ work( lwork ), x( * )
171 *
172 * ====================================================================
173 *
174 * ..
175 * .. Local Scalars ..
176  INTEGER info
177 * ..
178 * .. External Subroutines ..
179  EXTERNAL sgglse, slacpy, sget02
180 * ..
181 * .. Executable Statements ..
182 *
183 * Copy the matrices A and B to the arrays AF and BF,
184 * and the vectors C and D to the arrays CF and DF,
185 *
186  CALL slacpy( 'Full', m, n, a, lda, af, lda )
187  CALL slacpy( 'Full', p, n, b, ldb, bf, ldb )
188  CALL scopy( m, c, 1, cf, 1 )
189  CALL scopy( p, d, 1, df, 1 )
190 *
191 * Solve LSE problem
192 *
193  CALL sgglse( m, n, p, af, lda, bf, ldb, cf, df, x,
194  $ work, lwork, info )
195 *
196 * Test the residual for the solution of LSE
197 *
198 * Compute RESULT(1) = norm( A*x - c ) / norm(A)*norm(X)*EPS
199 *
200  CALL scopy( m, c, 1, cf, 1 )
201  CALL scopy( p, d, 1, df, 1 )
202  CALL sget02( 'No transpose', m, n, 1, a, lda, x, n, cf, m,
203  $ rwork, result( 1 ) )
204 *
205 * Compute result(2) = norm( B*x - d ) / norm(B)*norm(X)*EPS
206 *
207  CALL sget02( 'No transpose', p, n, 1, b, ldb, x, n, df, p,
208  $ rwork, result( 2 ) )
209 *
210  return
211 *
212 * End of SLSETS
213 *
214  END