![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CCKLSE 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 CCKLSE( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, 00012 * NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, 00013 * INFO ) 00014 * 00015 * .. Scalar Arguments .. 00016 * INTEGER INFO, NIN, NMATS, NMAX, NN, NOUT 00017 * REAL THRESH 00018 * .. 00019 * .. Array Arguments .. 00020 * INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * ) 00021 * REAL RWORK( * ) 00022 * COMPLEX A( * ), AF( * ), B( * ), BF( * ), WORK( * ), 00023 * $ X( * ) 00024 * .. 00025 * 00026 * 00027 *> \par Purpose: 00028 * ============= 00029 *> 00030 *> \verbatim 00031 *> 00032 *> CCKLSE tests CGGLSE - a subroutine for solving linear equality 00033 *> constrained least square problem (LSE). 00034 *> \endverbatim 00035 * 00036 * Arguments: 00037 * ========== 00038 * 00039 *> \param[in] NN 00040 *> \verbatim 00041 *> NN is INTEGER 00042 *> The number of values of (M,P,N) contained in the vectors 00043 *> (MVAL, PVAL, NVAL). 00044 *> \endverbatim 00045 *> 00046 *> \param[in] MVAL 00047 *> \verbatim 00048 *> MVAL is INTEGER array, dimension (NN) 00049 *> The values of the matrix row(column) dimension M. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] PVAL 00053 *> \verbatim 00054 *> PVAL is INTEGER array, dimension (NN) 00055 *> The values of the matrix row(column) dimension P. 00056 *> \endverbatim 00057 *> 00058 *> \param[in] NVAL 00059 *> \verbatim 00060 *> NVAL is INTEGER array, dimension (NN) 00061 *> The values of the matrix column(row) dimension N. 00062 *> \endverbatim 00063 *> 00064 *> \param[in] NMATS 00065 *> \verbatim 00066 *> NMATS is INTEGER 00067 *> The number of matrix types to be tested for each combination 00068 *> of matrix dimensions. If NMATS >= NTYPES (the maximum 00069 *> number of matrix types), then all the different types are 00070 *> generated for testing. If NMATS < NTYPES, another input line 00071 *> is read to get the numbers of the matrix types to be used. 00072 *> \endverbatim 00073 *> 00074 *> \param[in,out] ISEED 00075 *> \verbatim 00076 *> ISEED is INTEGER array, dimension (4) 00077 *> On entry, the seed of the random number generator. The array 00078 *> elements should be between 0 and 4095, otherwise they will be 00079 *> reduced mod 4096, and ISEED(4) must be odd. 00080 *> On exit, the next seed in the random number sequence after 00081 *> all the test matrices have been generated. 00082 *> \endverbatim 00083 *> 00084 *> \param[in] THRESH 00085 *> \verbatim 00086 *> THRESH is REAL 00087 *> The threshold value for the test ratios. A result is 00088 *> included in the output file if RESULT >= THRESH. To have 00089 *> every test ratio printed, use THRESH = 0. 00090 *> \endverbatim 00091 *> 00092 *> \param[in] NMAX 00093 *> \verbatim 00094 *> NMAX is INTEGER 00095 *> The maximum value permitted for M or N, used in dimensioning 00096 *> the work arrays. 00097 *> \endverbatim 00098 *> 00099 *> \param[out] A 00100 *> \verbatim 00101 *> A is COMPLEX array, dimension (NMAX*NMAX) 00102 *> \endverbatim 00103 *> 00104 *> \param[out] AF 00105 *> \verbatim 00106 *> AF is COMPLEX array, dimension (NMAX*NMAX) 00107 *> \endverbatim 00108 *> 00109 *> \param[out] B 00110 *> \verbatim 00111 *> B is COMPLEX array, dimension (NMAX*NMAX) 00112 *> \endverbatim 00113 *> 00114 *> \param[out] BF 00115 *> \verbatim 00116 *> BF is COMPLEX array, dimension (NMAX*NMAX) 00117 *> \endverbatim 00118 *> 00119 *> \param[out] X 00120 *> \verbatim 00121 *> X is COMPLEX array, dimension (5*NMAX) 00122 *> \endverbatim 00123 *> 00124 *> \param[out] WORK 00125 *> \verbatim 00126 *> WORK is COMPLEX array, dimension (NMAX*NMAX) 00127 *> \endverbatim 00128 *> 00129 *> \param[out] RWORK 00130 *> \verbatim 00131 *> RWORK is REAL array, dimension (NMAX) 00132 *> \endverbatim 00133 *> 00134 *> \param[in] NIN 00135 *> \verbatim 00136 *> NIN is INTEGER 00137 *> The unit number for input. 00138 *> \endverbatim 00139 *> 00140 *> \param[in] NOUT 00141 *> \verbatim 00142 *> NOUT is INTEGER 00143 *> The unit number for output. 00144 *> \endverbatim 00145 *> 00146 *> \param[out] INFO 00147 *> \verbatim 00148 *> INFO is INTEGER 00149 *> = 0 : successful exit 00150 *> > 0 : If CLATMS returns an error code, the absolute value 00151 *> of it is returned. 00152 *> \endverbatim 00153 * 00154 * Authors: 00155 * ======== 00156 * 00157 *> \author Univ. of Tennessee 00158 *> \author Univ. of California Berkeley 00159 *> \author Univ. of Colorado Denver 00160 *> \author NAG Ltd. 00161 * 00162 *> \date November 2011 00163 * 00164 *> \ingroup complex_eig 00165 * 00166 * ===================================================================== 00167 SUBROUTINE CCKLSE( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, 00168 $ NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, 00169 $ INFO ) 00170 * 00171 * -- LAPACK test routine (version 3.4.0) -- 00172 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00173 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00174 * November 2011 00175 * 00176 * .. Scalar Arguments .. 00177 INTEGER INFO, NIN, NMATS, NMAX, NN, NOUT 00178 REAL THRESH 00179 * .. 00180 * .. Array Arguments .. 00181 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * ) 00182 REAL RWORK( * ) 00183 COMPLEX A( * ), AF( * ), B( * ), BF( * ), WORK( * ), 00184 $ X( * ) 00185 * .. 00186 * 00187 * ===================================================================== 00188 * 00189 * .. Parameters .. 00190 INTEGER NTESTS 00191 PARAMETER ( NTESTS = 7 ) 00192 INTEGER NTYPES 00193 PARAMETER ( NTYPES = 8 ) 00194 * .. 00195 * .. Local Scalars .. 00196 LOGICAL FIRSTT 00197 CHARACTER DISTA, DISTB, TYPE 00198 CHARACTER*3 PATH 00199 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA, 00200 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN, 00201 $ NT, P 00202 REAL ANORM, BNORM, CNDNMA, CNDNMB 00203 * .. 00204 * .. Local Arrays .. 00205 LOGICAL DOTYPE( NTYPES ) 00206 REAL RESULT( NTESTS ) 00207 * .. 00208 * .. External Subroutines .. 00209 EXTERNAL ALAHDG, ALAREQ, ALASUM, CLARHS, CLATMS, CLSETS, 00210 $ SLATB9 00211 * .. 00212 * .. Intrinsic Functions .. 00213 INTRINSIC ABS, MAX 00214 * .. 00215 * .. Executable Statements .. 00216 * 00217 * Initialize constants and the random number seed. 00218 * 00219 PATH( 1: 3 ) = 'LSE' 00220 INFO = 0 00221 NRUN = 0 00222 NFAIL = 0 00223 FIRSTT = .TRUE. 00224 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00225 LDA = NMAX 00226 LDB = NMAX 00227 LWORK = NMAX*NMAX 00228 * 00229 * Check for valid input values. 00230 * 00231 DO 10 IK = 1, NN 00232 M = MVAL( IK ) 00233 P = PVAL( IK ) 00234 N = NVAL( IK ) 00235 IF( P.GT.N .OR. N.GT.M+P ) THEN 00236 IF( FIRSTT ) THEN 00237 WRITE( NOUT, FMT = * ) 00238 FIRSTT = .FALSE. 00239 END IF 00240 WRITE( NOUT, FMT = 9997 )M, P, N 00241 END IF 00242 10 CONTINUE 00243 FIRSTT = .TRUE. 00244 * 00245 * Do for each value of M in MVAL. 00246 * 00247 DO 40 IK = 1, NN 00248 M = MVAL( IK ) 00249 P = PVAL( IK ) 00250 N = NVAL( IK ) 00251 IF( P.GT.N .OR. N.GT.M+P ) 00252 $ GO TO 40 00253 * 00254 DO 30 IMAT = 1, NTYPES 00255 * 00256 * Do the tests only if DOTYPE( IMAT ) is true. 00257 * 00258 IF( .NOT.DOTYPE( IMAT ) ) 00259 $ GO TO 30 00260 * 00261 * Set up parameters with SLATB9 and generate test 00262 * matrices A and B with CLATMS. 00263 * 00264 CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, 00265 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, 00266 $ DISTA, DISTB ) 00267 * 00268 CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA, 00269 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK, 00270 $ IINFO ) 00271 IF( IINFO.NE.0 ) THEN 00272 WRITE( NOUT, FMT = 9999 )IINFO 00273 INFO = ABS( IINFO ) 00274 GO TO 30 00275 END IF 00276 * 00277 CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB, 00278 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK, 00279 $ IINFO ) 00280 IF( IINFO.NE.0 ) THEN 00281 WRITE( NOUT, FMT = 9999 )IINFO 00282 INFO = ABS( IINFO ) 00283 GO TO 30 00284 END IF 00285 * 00286 * Generate the right-hand sides C and D for the LSE. 00287 * 00288 CALL CLARHS( 'CGE', 'New solution', 'Upper', 'N', M, N, 00289 $ MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA, 00290 $ X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ), 00291 $ ISEED, IINFO ) 00292 * 00293 CALL CLARHS( 'CGE', 'Computed', 'Upper', 'N', P, N, 00294 $ MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB, 00295 $ X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ), 00296 $ MAX( P, 1 ), ISEED, IINFO ) 00297 * 00298 NT = 2 00299 * 00300 CALL CLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X, 00301 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ), 00302 $ X( 4*NMAX+1 ), WORK, LWORK, RWORK, 00303 $ RESULT( 1 ) ) 00304 * 00305 * Print information about the tests that did not 00306 * pass the threshold. 00307 * 00308 DO 20 I = 1, NT 00309 IF( RESULT( I ).GE.THRESH ) THEN 00310 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00311 FIRSTT = .FALSE. 00312 CALL ALAHDG( NOUT, PATH ) 00313 END IF 00314 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I, 00315 $ RESULT( I ) 00316 NFAIL = NFAIL + 1 00317 END IF 00318 20 CONTINUE 00319 NRUN = NRUN + NT 00320 * 00321 30 CONTINUE 00322 40 CONTINUE 00323 * 00324 * Print a summary of the results. 00325 * 00326 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 ) 00327 * 00328 9999 FORMAT( ' CLATMS in CCKLSE INFO = ', I5 ) 00329 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2, 00330 $ ', test ', I2, ', ratio=', G13.6 ) 00331 9997 FORMAT( ' *** Invalid input for LSE: M = ', I6, ', P = ', I6, 00332 $ ', N = ', I6, ';', / ' must satisfy P <= N <= P+M ', 00333 $ '(this set of values will be skipped)' ) 00334 RETURN 00335 * 00336 * End of CCKLSE 00337 * 00338 END