LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 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:158
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 clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
subroutine cggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
CGGGLM
Definition: cggglm.f:185