LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sglmts.f
Go to the documentation of this file.
1*> \brief \b SGLMTS
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 SGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, D, DF,
12* X, U, WORK, LWORK, RWORK, RESULT )
13*
14* .. Scalar Arguments ..
15* INTEGER LDA, LDB, LWORK, M, P, N
16* REAL RESULT
17* ..
18* .. Array Arguments ..
19* REAL A( LDA, * ), AF( LDA, * ), B( LDB, * ),
20* $ BF( LDB, * ), RWORK( * ), D( * ), DF( * ),
21* $ U( * ), WORK( LWORK ), X( * )
22*
23*
24*> \par Purpose:
25* =============
26*>
27*> \verbatim
28*>
29*> SGLMTS tests SGGGLM - a subroutine for solving the generalized
30*> linear model problem.
31*> \endverbatim
32*
33* Arguments:
34* ==========
35*
36*> \param[in] N
37*> \verbatim
38*> N is INTEGER
39*> The number of rows of the matrices A and B. N >= 0.
40*> \endverbatim
41*>
42*> \param[in] M
43*> \verbatim
44*> M is INTEGER
45*> The number of columns of the matrix A. M >= 0.
46*> \endverbatim
47*>
48*> \param[in] P
49*> \verbatim
50*> P is INTEGER
51*> The number of columns of the matrix B. P >= 0.
52*> \endverbatim
53*>
54*> \param[in] A
55*> \verbatim
56*> A is REAL array, dimension (LDA,M)
57*> The N-by-M matrix A.
58*> \endverbatim
59*>
60*> \param[out] AF
61*> \verbatim
62*> AF is REAL array, dimension (LDA,M)
63*> \endverbatim
64*>
65*> \param[in] LDA
66*> \verbatim
67*> LDA is INTEGER
68*> The leading dimension of the arrays A, AF. LDA >= max(M,N).
69*> \endverbatim
70*>
71*> \param[in] B
72*> \verbatim
73*> B is REAL array, dimension (LDB,P)
74*> The N-by-P matrix A.
75*> \endverbatim
76*>
77*> \param[out] BF
78*> \verbatim
79*> BF is REAL array, dimension (LDB,P)
80*> \endverbatim
81*>
82*> \param[in] LDB
83*> \verbatim
84*> LDB is INTEGER
85*> The leading dimension of the arrays B, BF. LDB >= max(P,N).
86*> \endverbatim
87*>
88*> \param[in] D
89*> \verbatim
90*> D is REAL array, dimension( N )
91*> On input, the left hand side of the GLM.
92*> \endverbatim
93*>
94*> \param[out] DF
95*> \verbatim
96*> DF is REAL array, dimension( N )
97*> \endverbatim
98*>
99*> \param[out] X
100*> \verbatim
101*> X is REAL array, dimension( M )
102*> solution vector X in the GLM problem.
103*> \endverbatim
104*>
105*> \param[out] U
106*> \verbatim
107*> U is REAL array, dimension( P )
108*> solution vector U in the GLM problem.
109*> \endverbatim
110*>
111*> \param[out] WORK
112*> \verbatim
113*> WORK is REAL array, dimension (LWORK)
114*> \endverbatim
115*>
116*> \param[in] LWORK
117*> \verbatim
118*> LWORK is INTEGER
119*> The dimension of the array WORK.
120*> \endverbatim
121*>
122*> \param[out] RWORK
123*> \verbatim
124*> RWORK is REAL array, dimension (M)
125*> \endverbatim
126*>
127*> \param[out] RESULT
128*> \verbatim
129*> RESULT is REAL
130*> The test ratio:
131*> norm( d - A*x - B*u )
132*> RESULT = -----------------------------------------
133*> (norm(A)+norm(B))*(norm(x)+norm(u))*EPS
134*> \endverbatim
135*
136* Authors:
137* ========
138*
139*> \author Univ. of Tennessee
140*> \author Univ. of California Berkeley
141*> \author Univ. of Colorado Denver
142*> \author NAG Ltd.
143*
144*> \ingroup single_eig
145*
146* =====================================================================
147 SUBROUTINE sglmts( N, M, P, A, AF, LDA, B, BF, LDB, D, DF,
148 $ X, U, WORK, LWORK, RWORK, RESULT )
149*
150* -- LAPACK test routine --
151* -- LAPACK is a software package provided by Univ. of Tennessee, --
152* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153*
154* .. Scalar Arguments ..
155 INTEGER LDA, LDB, LWORK, M, P, N
156 REAL RESULT
157* ..
158* .. Array Arguments ..
159 REAL A( LDA, * ), AF( LDA, * ), B( LDB, * ),
160 $ bf( ldb, * ), rwork( * ), d( * ), df( * ),
161 $ u( * ), work( lwork ), x( * )
162*
163* ====================================================================
164*
165* .. Parameters ..
166 REAL ZERO, ONE
167 parameter( zero = 0.0e+0, one = 1.0e+0 )
168* ..
169* .. Local Scalars ..
170 INTEGER INFO
171 REAL ANORM, BNORM, EPS, XNORM, YNORM, DNORM, UNFL
172* ..
173* .. External Functions ..
174 REAL SASUM, SLAMCH, SLANGE
175 EXTERNAL sasum, slamch, slange
176* ..
177* .. External Subroutines ..
178 EXTERNAL slacpy
179*
180* .. Intrinsic Functions ..
181 INTRINSIC max
182* ..
183* .. Executable Statements ..
184*
185 eps = slamch( 'Epsilon' )
186 unfl = slamch( 'Safe minimum' )
187 anorm = max( slange( '1', n, m, a, lda, rwork ), unfl )
188 bnorm = max( slange( '1', n, p, b, ldb, rwork ), unfl )
189*
190* Copy the matrices A and B to the arrays AF and BF,
191* and the vector D the array DF.
192*
193 CALL slacpy( 'Full', n, m, a, lda, af, lda )
194 CALL slacpy( 'Full', n, p, b, ldb, bf, ldb )
195 CALL scopy( n, d, 1, df, 1 )
196*
197* Solve GLM problem
198*
199 CALL sggglm( n, m, p, af, lda, bf, ldb, df, x, u, work, lwork,
200 $ info )
201*
202* Test the residual for the solution of LSE
203*
204* norm( d - A*x - B*u )
205* RESULT = -----------------------------------------
206* (norm(A)+norm(B))*(norm(x)+norm(u))*EPS
207*
208 CALL scopy( n, d, 1, df, 1 )
209 CALL sgemv( 'No transpose', n, m, -one, a, lda, x, 1,
210 $ one, df, 1 )
211*
212 CALL sgemv( 'No transpose', n, p, -one, b, ldb, u, 1,
213 $ one, df, 1 )
214*
215 dnorm = sasum( n, df, 1 )
216 xnorm = sasum( m, x, 1 ) + sasum( p, u, 1 )
217 ynorm = anorm + bnorm
218*
219 IF( xnorm.LE.zero ) THEN
220 result = zero
221 ELSE
222 result = ( ( dnorm / ynorm ) / xnorm ) /eps
223 END IF
224*
225 RETURN
226*
227* End of SGLMTS
228*
229 END
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
Definition: slacpy.f:103
subroutine sggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
SGGGLM
Definition: sggglm.f:185
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
Definition: scopy.f:82
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
Definition: sgemv.f:156
subroutine sglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
SGLMTS
Definition: sglmts.f:149