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