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