|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CCKGQR( NM, MVAL, NP, PVAL, NN, NVAL, NMATS, ISEED, 00002 $ THRESH, NMAX, A, AF, AQ, AR, TAUA, B, BF, BZ, 00003 $ BT, BWK, TAUB, WORK, RWORK, NIN, NOUT, INFO ) 00004 * 00005 * -- LAPACK test routine (version 3.1) -- 00006 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 INTEGER INFO, NIN, NM, NMATS, NMAX, NN, NOUT, NP 00011 REAL THRESH 00012 * .. 00013 * .. Array Arguments .. 00014 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * ) 00015 REAL RWORK( * ) 00016 COMPLEX A( * ), AF( * ), AQ( * ), AR( * ), B( * ), 00017 $ BF( * ), BT( * ), BWK( * ), BZ( * ), TAUA( * ), 00018 $ TAUB( * ), WORK( * ) 00019 * .. 00020 * 00021 * Purpose 00022 * ======= 00023 * 00024 * CCKGQR tests 00025 * CGGQRF: GQR factorization for N-by-M matrix A and N-by-P matrix B, 00026 * CGGRQF: GRQ factorization for M-by-N matrix A and P-by-N matrix B. 00027 * 00028 * Arguments 00029 * ========= 00030 * 00031 * NM (input) INTEGER 00032 * The number of values of M contained in the vector MVAL. 00033 * 00034 * MVAL (input) INTEGER array, dimension (NM) 00035 * The values of the matrix row(column) dimension M. 00036 * 00037 * NP (input) INTEGER 00038 * The number of values of P contained in the vector PVAL. 00039 * 00040 * PVAL (input) INTEGER array, dimension (NP) 00041 * The values of the matrix row(column) dimension P. 00042 * 00043 * NN (input) INTEGER 00044 * The number of values of N contained in the vector NVAL. 00045 * 00046 * NVAL (input) INTEGER array, dimension (NN) 00047 * The values of the matrix column(row) dimension N. 00048 * 00049 * NMATS (input) INTEGER 00050 * The number of matrix types to be tested for each combination 00051 * of matrix dimensions. If NMATS >= NTYPES (the maximum 00052 * number of matrix types), then all the different types are 00053 * generated for testing. If NMATS < NTYPES, another input line 00054 * is read to get the numbers of the matrix types to be used. 00055 * 00056 * ISEED (input/output) INTEGER array, dimension (4) 00057 * On entry, the seed of the random number generator. The array 00058 * elements should be between 0 and 4095, otherwise they will be 00059 * reduced mod 4096, and ISEED(4) must be odd. 00060 * On exit, the next seed in the random number sequence after 00061 * all the test matrices have been generated. 00062 * 00063 * THRESH (input) REAL 00064 * The threshold value for the test ratios. A result is 00065 * included in the output file if RESULT >= THRESH. To have 00066 * every test ratio printed, use THRESH = 0. 00067 * 00068 * NMAX (input) INTEGER 00069 * The maximum value permitted for M or N, used in dimensioning 00070 * the work arrays. 00071 * 00072 * A (workspace) COMPLEX array, dimension (NMAX*NMAX) 00073 * 00074 * AF (workspace) COMPLEX array, dimension (NMAX*NMAX) 00075 * 00076 * AQ (workspace) COMPLEX array, dimension (NMAX*NMAX) 00077 * 00078 * AR (workspace) COMPLEX array, dimension (NMAX*NMAX) 00079 * 00080 * TAUA (workspace) COMPLEX array, dimension (NMAX) 00081 * 00082 * B (workspace) COMPLEX array, dimension (NMAX*NMAX) 00083 * 00084 * BF (workspace) COMPLEX array, dimension (NMAX*NMAX) 00085 * 00086 * BZ (workspace) COMPLEX array, dimension (NMAX*NMAX) 00087 * 00088 * BT (workspace) COMPLEX array, dimension (NMAX*NMAX) 00089 * 00090 * BWK (workspace) COMPLEX array, dimension (NMAX*NMAX) 00091 * 00092 * TAUB (workspace) COMPLEX array, dimension (NMAX) 00093 * 00094 * WORK (workspace) COMPLEX array, dimension (NMAX*NMAX) 00095 * 00096 * RWORK (workspace) REAL array, dimension (NMAX) 00097 * 00098 * NIN (input) INTEGER 00099 * The unit number for input. 00100 * 00101 * NOUT (input) INTEGER 00102 * The unit number for output. 00103 * 00104 * INFO (output) INTEGER 00105 * = 0 : successful exit 00106 * > 0 : If CLATMS returns an error code, the absolute value 00107 * of it is returned. 00108 * 00109 * ===================================================================== 00110 * 00111 * .. Parameters .. 00112 INTEGER NTESTS 00113 PARAMETER ( NTESTS = 7 ) 00114 INTEGER NTYPES 00115 PARAMETER ( NTYPES = 8 ) 00116 * .. 00117 * .. Local Scalars .. 00118 LOGICAL FIRSTT 00119 CHARACTER DISTA, DISTB, TYPE 00120 CHARACTER*3 PATH 00121 INTEGER I, IINFO, IM, IMAT, IN, IP, KLA, KLB, KUA, KUB, 00122 $ LDA, LDB, LWORK, M, MODEA, MODEB, N, NFAIL, 00123 $ NRUN, NT, P 00124 REAL ANORM, BNORM, CNDNMA, CNDNMB 00125 * .. 00126 * .. Local Arrays .. 00127 LOGICAL DOTYPE( NTYPES ) 00128 REAL RESULT( NTESTS ) 00129 * .. 00130 * .. External Subroutines .. 00131 EXTERNAL ALAHDG, ALAREQ, ALASUM, CGQRTS, CGRQTS, CLATMS, 00132 $ SLATB9 00133 * .. 00134 * .. Intrinsic Functions .. 00135 INTRINSIC ABS 00136 * .. 00137 * .. Executable Statements .. 00138 * 00139 * Initialize constants. 00140 * 00141 PATH( 1: 3 ) = 'GQR' 00142 INFO = 0 00143 NRUN = 0 00144 NFAIL = 0 00145 FIRSTT = .TRUE. 00146 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00147 LDA = NMAX 00148 LDB = NMAX 00149 LWORK = NMAX*NMAX 00150 * 00151 * Do for each value of M in MVAL. 00152 * 00153 DO 60 IM = 1, NM 00154 M = MVAL( IM ) 00155 * 00156 * Do for each value of P in PVAL. 00157 * 00158 DO 50 IP = 1, NP 00159 P = PVAL( IP ) 00160 * 00161 * Do for each value of N in NVAL. 00162 * 00163 DO 40 IN = 1, NN 00164 N = NVAL( IN ) 00165 * 00166 DO 30 IMAT = 1, NTYPES 00167 * 00168 * Do the tests only if DOTYPE( IMAT ) is true. 00169 * 00170 IF( .NOT.DOTYPE( IMAT ) ) 00171 $ GO TO 30 00172 * 00173 * Test CGGRQF 00174 * 00175 * Set up parameters with SLATB9 and generate test 00176 * matrices A and B with CLATMS. 00177 * 00178 CALL SLATB9( 'GRQ', IMAT, M, P, N, TYPE, KLA, KUA, 00179 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB, 00180 $ CNDNMA, CNDNMB, DISTA, DISTB ) 00181 * 00182 CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, 00183 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A, 00184 $ LDA, WORK, IINFO ) 00185 IF( IINFO.NE.0 ) THEN 00186 WRITE( NOUT, FMT = 9999 )IINFO 00187 INFO = ABS( IINFO ) 00188 GO TO 30 00189 END IF 00190 * 00191 CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, 00192 $ CNDNMB, BNORM, KLB, KUB, 'No packing', B, 00193 $ LDB, WORK, IINFO ) 00194 IF( IINFO.NE.0 ) THEN 00195 WRITE( NOUT, FMT = 9999 )IINFO 00196 INFO = ABS( IINFO ) 00197 GO TO 30 00198 END IF 00199 * 00200 NT = 4 00201 * 00202 CALL CGRQTS( M, P, N, A, AF, AQ, AR, LDA, TAUA, B, BF, 00203 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK, 00204 $ RWORK, RESULT ) 00205 * 00206 * Print information about the tests that did not 00207 * pass the threshold. 00208 * 00209 DO 10 I = 1, NT 00210 IF( RESULT( I ).GE.THRESH ) THEN 00211 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00212 FIRSTT = .FALSE. 00213 CALL ALAHDG( NOUT, 'GRQ' ) 00214 END IF 00215 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I, 00216 $ RESULT( I ) 00217 NFAIL = NFAIL + 1 00218 END IF 00219 10 CONTINUE 00220 NRUN = NRUN + NT 00221 * 00222 * Test CGGQRF 00223 * 00224 * Set up parameters with SLATB9 and generate test 00225 * matrices A and B with CLATMS. 00226 * 00227 CALL SLATB9( 'GQR', IMAT, M, P, N, TYPE, KLA, KUA, 00228 $ KLB, KUB, ANORM, BNORM, MODEA, MODEB, 00229 $ CNDNMA, CNDNMB, DISTA, DISTB ) 00230 * 00231 CALL CLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA, 00232 $ CNDNMA, ANORM, KLA, KUA, 'No packing', A, 00233 $ LDA, WORK, IINFO ) 00234 IF( IINFO.NE.0 ) THEN 00235 WRITE( NOUT, FMT = 9999 )IINFO 00236 INFO = ABS( IINFO ) 00237 GO TO 30 00238 END IF 00239 * 00240 CALL CLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEA, 00241 $ CNDNMA, BNORM, KLB, KUB, 'No packing', B, 00242 $ LDB, WORK, IINFO ) 00243 IF( IINFO.NE.0 ) THEN 00244 WRITE( NOUT, FMT = 9999 )IINFO 00245 INFO = ABS( IINFO ) 00246 GO TO 30 00247 END IF 00248 * 00249 NT = 4 00250 * 00251 CALL CGQRTS( N, M, P, A, AF, AQ, AR, LDA, TAUA, B, BF, 00252 $ BZ, BT, BWK, LDB, TAUB, WORK, LWORK, 00253 $ RWORK, RESULT ) 00254 * 00255 * Print information about the tests that did not 00256 * pass the threshold. 00257 * 00258 DO 20 I = 1, NT 00259 IF( RESULT( I ).GE.THRESH ) THEN 00260 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00261 FIRSTT = .FALSE. 00262 CALL ALAHDG( NOUT, PATH ) 00263 END IF 00264 WRITE( NOUT, FMT = 9997 )N, M, P, IMAT, I, 00265 $ RESULT( I ) 00266 NFAIL = NFAIL + 1 00267 END IF 00268 20 CONTINUE 00269 NRUN = NRUN + NT 00270 * 00271 30 CONTINUE 00272 40 CONTINUE 00273 50 CONTINUE 00274 60 CONTINUE 00275 * 00276 * Print a summary of the results. 00277 * 00278 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 ) 00279 * 00280 9999 FORMAT( ' CLATMS in CCKGQR: INFO = ', I5 ) 00281 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2, 00282 $ ', test ', I2, ', ratio=', G13.6 ) 00283 9997 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2, 00284 $ ', test ', I2, ', ratio=', G13.6 ) 00285 RETURN 00286 * 00287 * End of CCKGQR 00288 * 00289 END
1.7.3 
