![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CGLMTS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE CGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, D, DF, 00012 * X, U, WORK, LWORK, RWORK, RESULT ) 00013 * 00014 * .. Scalar Arguments .. 00015 * INTEGER LDA, LDB, LWORK, M, P, N 00016 * REAL RESULT 00017 * .. 00018 * .. Array Arguments .. 00019 * REAL RWORK( * ) 00020 * COMPLEX A( LDA, * ), AF( LDA, * ), B( LDB, * ), 00021 * $ BF( LDB, * ), D( * ), DF( * ), U( * ), 00022 * $ WORK( LWORK ), X( * ) 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> CGLMTS tests CGGGLM - a subroutine for solving the generalized 00031 *> linear model problem. 00032 *> \endverbatim 00033 * 00034 * Arguments: 00035 * ========== 00036 * 00037 *> \param[in] N 00038 *> \verbatim 00039 *> N is INTEGER 00040 *> The number of rows of the matrices A and B. N >= 0. 00041 *> \endverbatim 00042 *> 00043 *> \param[in] M 00044 *> \verbatim 00045 *> M is INTEGER 00046 *> The number of columns of the matrix A. M >= 0. 00047 *> \endverbatim 00048 *> 00049 *> \param[in] P 00050 *> \verbatim 00051 *> P is INTEGER 00052 *> The number of columns of the matrix B. P >= 0. 00053 *> \endverbatim 00054 *> 00055 *> \param[in] A 00056 *> \verbatim 00057 *> A is COMPLEX array, dimension (LDA,M) 00058 *> The N-by-M matrix A. 00059 *> \endverbatim 00060 *> 00061 *> \param[out] AF 00062 *> \verbatim 00063 *> AF is COMPLEX array, dimension (LDA,M) 00064 *> \endverbatim 00065 *> 00066 *> \param[in] LDA 00067 *> \verbatim 00068 *> LDA is INTEGER 00069 *> The leading dimension of the arrays A, AF. LDA >= max(M,N). 00070 *> \endverbatim 00071 *> 00072 *> \param[in] B 00073 *> \verbatim 00074 *> B is COMPLEX array, dimension (LDB,P) 00075 *> The N-by-P matrix A. 00076 *> \endverbatim 00077 *> 00078 *> \param[out] BF 00079 *> \verbatim 00080 *> BF is COMPLEX array, dimension (LDB,P) 00081 *> \endverbatim 00082 *> 00083 *> \param[in] LDB 00084 *> \verbatim 00085 *> LDB is INTEGER 00086 *> The leading dimension of the arrays B, BF. LDB >= max(P,N). 00087 *> \endverbatim 00088 *> 00089 *> \param[in] D 00090 *> \verbatim 00091 *> D is COMPLEX array, dimension( N ) 00092 *> On input, the left hand side of the GLM. 00093 *> \endverbatim 00094 *> 00095 *> \param[out] DF 00096 *> \verbatim 00097 *> DF is COMPLEX array, dimension( N ) 00098 *> \endverbatim 00099 *> 00100 *> \param[out] X 00101 *> \verbatim 00102 *> X is COMPLEX array, dimension( M ) 00103 *> solution vector X in the GLM problem. 00104 *> \endverbatim 00105 *> 00106 *> \param[out] U 00107 *> \verbatim 00108 *> U is COMPLEX array, dimension( P ) 00109 *> solution vector U in the GLM problem. 00110 *> \endverbatim 00111 *> 00112 *> \param[out] WORK 00113 *> \verbatim 00114 *> WORK is COMPLEX array, dimension (LWORK) 00115 *> \endverbatim 00116 *> 00117 *> \param[in] LWORK 00118 *> \verbatim 00119 *> LWORK is INTEGER 00120 *> The dimension of the array WORK. 00121 *> \endverbatim 00122 *> 00123 *> \param[out] RWORK 00124 *> \verbatim 00125 *> RWORK is REAL array, dimension (M) 00126 *> \endverbatim 00127 *> 00128 *> \param[out] RESULT 00129 *> \verbatim 00130 *> RESULT is REAL 00131 *> The test ratio: 00132 *> norm( d - A*x - B*u ) 00133 *> RESULT = ----------------------------------------- 00134 *> (norm(A)+norm(B))*(norm(x)+norm(u))*EPS 00135 *> \endverbatim 00136 * 00137 * Authors: 00138 * ======== 00139 * 00140 *> \author Univ. of Tennessee 00141 *> \author Univ. of California Berkeley 00142 *> \author Univ. of Colorado Denver 00143 *> \author NAG Ltd. 00144 * 00145 *> \date November 2011 00146 * 00147 *> \ingroup complex_eig 00148 * 00149 * ===================================================================== 00150 SUBROUTINE CGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, D, DF, 00151 $ X, U, WORK, LWORK, RWORK, RESULT ) 00152 * 00153 * -- LAPACK test routine (version 3.4.0) -- 00154 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00155 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00156 * November 2011 00157 * 00158 * .. Scalar Arguments .. 00159 INTEGER LDA, LDB, LWORK, M, P, N 00160 REAL RESULT 00161 * .. 00162 * .. Array Arguments .. 00163 REAL RWORK( * ) 00164 COMPLEX A( LDA, * ), AF( LDA, * ), B( LDB, * ), 00165 $ BF( LDB, * ), D( * ), DF( * ), U( * ), 00166 $ WORK( LWORK ), X( * ) 00167 * 00168 * ==================================================================== 00169 * 00170 * .. Parameters .. 00171 REAL ZERO 00172 PARAMETER ( ZERO = 0.0E+0 ) 00173 COMPLEX CONE 00174 PARAMETER ( CONE = 1.0E+0 ) 00175 * .. 00176 * .. Local Scalars .. 00177 INTEGER INFO 00178 REAL ANORM, BNORM, EPS, XNORM, YNORM, DNORM, UNFL 00179 * .. 00180 * .. External Functions .. 00181 REAL SCASUM, SLAMCH, CLANGE 00182 EXTERNAL SCASUM, SLAMCH, CLANGE 00183 * .. 00184 * .. External Subroutines .. 00185 EXTERNAL CLACPY 00186 * 00187 * .. Intrinsic Functions .. 00188 INTRINSIC MAX 00189 * .. 00190 * .. Executable Statements .. 00191 * 00192 EPS = SLAMCH( 'Epsilon' ) 00193 UNFL = SLAMCH( 'Safe minimum' ) 00194 ANORM = MAX( CLANGE( '1', N, M, A, LDA, RWORK ), UNFL ) 00195 BNORM = MAX( CLANGE( '1', N, P, B, LDB, RWORK ), UNFL ) 00196 * 00197 * Copy the matrices A and B to the arrays AF and BF, 00198 * and the vector D the array DF. 00199 * 00200 CALL CLACPY( 'Full', N, M, A, LDA, AF, LDA ) 00201 CALL CLACPY( 'Full', N, P, B, LDB, BF, LDB ) 00202 CALL CCOPY( N, D, 1, DF, 1 ) 00203 * 00204 * Solve GLM problem 00205 * 00206 CALL CGGGLM( N, M, P, AF, LDA, BF, LDB, DF, X, U, WORK, LWORK, 00207 $ INFO ) 00208 * 00209 * Test the residual for the solution of LSE 00210 * 00211 * norm( d - A*x - B*u ) 00212 * RESULT = ----------------------------------------- 00213 * (norm(A)+norm(B))*(norm(x)+norm(u))*EPS 00214 * 00215 CALL CCOPY( N, D, 1, DF, 1 ) 00216 CALL CGEMV( 'No transpose', N, M, -CONE, A, LDA, X, 1, CONE, 00217 $ DF, 1 ) 00218 * 00219 CALL CGEMV( 'No transpose', N, P, -CONE, B, LDB, U, 1, CONE, 00220 $ DF, 1 ) 00221 * 00222 DNORM = SCASUM( N, DF, 1 ) 00223 XNORM = SCASUM( M, X, 1 ) + SCASUM( P, U, 1 ) 00224 YNORM = ANORM + BNORM 00225 * 00226 IF( XNORM.LE.ZERO ) THEN 00227 RESULT = ZERO 00228 ELSE 00229 RESULT = ( ( DNORM / YNORM ) / XNORM ) /EPS 00230 END IF 00231 * 00232 RETURN 00233 * 00234 * End of CGLMTS 00235 * 00236 END