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