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