![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SCKGLM 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 SCKGLM( 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 A( * ), AF( * ), B( * ), BF( * ), RWORK( * ), 00022 * $ WORK( * ), X( * ) 00023 * .. 00024 * 00025 * 00026 *> \par Purpose: 00027 * ============= 00028 *> 00029 *> \verbatim 00030 *> 00031 *> SCKGLM tests SGGGLM - subroutine for solving generalized linear 00032 *> model problem. 00033 *> \endverbatim 00034 * 00035 * Arguments: 00036 * ========== 00037 * 00038 *> \param[in] NN 00039 *> \verbatim 00040 *> NN is INTEGER 00041 *> The number of values of N, M and P contained in the vectors 00042 *> NVAL, MVAL and PVAL. 00043 *> \endverbatim 00044 *> 00045 *> \param[in] MVAL 00046 *> \verbatim 00047 *> MVAL is INTEGER array, dimension (NN) 00048 *> The values of the matrix 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 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 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 REAL 00086 *> The threshold value for the test ratios. A result is 00087 *> included in the output file if RESID >= 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 REAL array, dimension (NMAX*NMAX) 00101 *> \endverbatim 00102 *> 00103 *> \param[out] AF 00104 *> \verbatim 00105 *> AF is REAL array, dimension (NMAX*NMAX) 00106 *> \endverbatim 00107 *> 00108 *> \param[out] B 00109 *> \verbatim 00110 *> B is REAL array, dimension (NMAX*NMAX) 00111 *> \endverbatim 00112 *> 00113 *> \param[out] BF 00114 *> \verbatim 00115 *> BF is REAL array, dimension (NMAX*NMAX) 00116 *> \endverbatim 00117 *> 00118 *> \param[out] X 00119 *> \verbatim 00120 *> X is REAL array, dimension (4*NMAX) 00121 *> \endverbatim 00122 *> 00123 *> \param[out] RWORK 00124 *> \verbatim 00125 *> RWORK is REAL array, dimension (NMAX) 00126 *> \endverbatim 00127 *> 00128 *> \param[out] WORK 00129 *> \verbatim 00130 *> WORK is REAL array, dimension (NMAX*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 SLATMS 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 single_eig 00164 * 00165 * ===================================================================== 00166 SUBROUTINE SCKGLM( 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 REAL THRESH 00178 * .. 00179 * .. Array Arguments .. 00180 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * ) 00181 REAL A( * ), AF( * ), B( * ), BF( * ), RWORK( * ), 00182 $ WORK( * ), X( * ) 00183 * .. 00184 * 00185 * ===================================================================== 00186 * 00187 * .. Parameters .. 00188 INTEGER NTYPES 00189 PARAMETER ( NTYPES = 8 ) 00190 * .. 00191 * .. Local Scalars .. 00192 LOGICAL FIRSTT 00193 CHARACTER DISTA, DISTB, TYPE 00194 CHARACTER*3 PATH 00195 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA, 00196 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN, P 00197 REAL ANORM, BNORM, CNDNMA, CNDNMB, RESID 00198 * .. 00199 * .. Local Arrays .. 00200 LOGICAL DOTYPE( NTYPES ) 00201 * .. 00202 * .. External Functions .. 00203 REAL SLARND 00204 EXTERNAL SLARND 00205 * .. 00206 * .. External Subroutines .. 00207 EXTERNAL ALAHDG, ALAREQ, ALASUM, SGLMTS, SLATB9, SLATMS 00208 * .. 00209 * .. Intrinsic Functions .. 00210 INTRINSIC ABS 00211 * .. 00212 * .. Executable Statements .. 00213 * 00214 * Initialize constants. 00215 * 00216 PATH( 1: 3 ) = 'GLM' 00217 INFO = 0 00218 NRUN = 0 00219 NFAIL = 0 00220 FIRSTT = .TRUE. 00221 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00222 LDA = NMAX 00223 LDB = NMAX 00224 LWORK = NMAX*NMAX 00225 * 00226 * Check for valid input values. 00227 * 00228 DO 10 IK = 1, NN 00229 M = MVAL( IK ) 00230 P = PVAL( IK ) 00231 N = NVAL( IK ) 00232 IF( M.GT.N .OR. N.GT.M+P ) THEN 00233 IF( FIRSTT ) THEN 00234 WRITE( NOUT, FMT = * ) 00235 FIRSTT = .FALSE. 00236 END IF 00237 WRITE( NOUT, FMT = 9997 )M, P, N 00238 END IF 00239 10 CONTINUE 00240 FIRSTT = .TRUE. 00241 * 00242 * Do for each value of M in MVAL. 00243 * 00244 DO 40 IK = 1, NN 00245 M = MVAL( IK ) 00246 P = PVAL( IK ) 00247 N = NVAL( IK ) 00248 IF( M.GT.N .OR. N.GT.M+P ) 00249 $ GO TO 40 00250 * 00251 DO 30 IMAT = 1, NTYPES 00252 * 00253 * Do the tests only if DOTYPE( IMAT ) is true. 00254 * 00255 IF( .NOT.DOTYPE( IMAT ) ) 00256 $ GO TO 30 00257 * 00258 * Set up parameters with SLATB9 and generate test 00259 * matrices A and B with SLATMS. 00260 * 00261 CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, 00262 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, 00263 $ DISTA, DISTB ) 00264 * 00265 CALL SLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA, 00266 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK, 00267 $ IINFO ) 00268 IF( IINFO.NE.0 ) THEN 00269 WRITE( NOUT, FMT = 9999 )IINFO 00270 INFO = ABS( IINFO ) 00271 GO TO 30 00272 END IF 00273 * 00274 CALL SLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB, 00275 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK, 00276 $ IINFO ) 00277 IF( IINFO.NE.0 ) THEN 00278 WRITE( NOUT, FMT = 9999 )IINFO 00279 INFO = ABS( IINFO ) 00280 GO TO 30 00281 END IF 00282 * 00283 * Generate random left hand side vector of GLM 00284 * 00285 DO 20 I = 1, N 00286 X( I ) = SLARND( 2, ISEED ) 00287 20 CONTINUE 00288 * 00289 CALL SGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, X, 00290 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ), 00291 $ WORK, LWORK, RWORK, RESID ) 00292 * 00293 * Print information about the tests that did not 00294 * pass the threshold. 00295 * 00296 IF( RESID.GE.THRESH ) THEN 00297 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00298 FIRSTT = .FALSE. 00299 CALL ALAHDG( NOUT, PATH ) 00300 END IF 00301 WRITE( NOUT, FMT = 9998 )N, M, P, IMAT, 1, RESID 00302 NFAIL = NFAIL + 1 00303 END IF 00304 NRUN = NRUN + 1 00305 * 00306 30 CONTINUE 00307 40 CONTINUE 00308 * 00309 * Print a summary of the results. 00310 * 00311 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 ) 00312 * 00313 9999 FORMAT( ' SLATMS in SCKGLM INFO = ', I5 ) 00314 9998 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2, 00315 $ ', test ', I2, ', ratio=', G13.6 ) 00316 9997 FORMAT( ' *** Invalid input for GLM: M = ', I6, ', P = ', I6, 00317 $ ', N = ', I6, ';', / ' must satisfy M <= N <= M+P ', 00318 $ '(this set of values will be skipped)' ) 00319 RETURN 00320 * 00321 * End of SCKGLM 00322 * 00323 END