![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SCKGSV 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 SCKGSV( NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, 00012 * NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R, 00013 * IWORK, WORK, RWORK, NIN, NOUT, INFO ) 00014 * 00015 * .. Scalar Arguments .. 00016 * INTEGER INFO, NIN, NM, NMATS, NMAX, NOUT 00017 * REAL THRESH 00018 * .. 00019 * .. Array Arguments .. 00020 * INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ), 00021 * $ PVAL( * ) 00022 * REAL A( * ), AF( * ), ALPHA( * ), B( * ), BETA( * ), 00023 * $ BF( * ), Q( * ), R( * ), RWORK( * ), U( * ), 00024 * $ V( * ), WORK( * ) 00025 * .. 00026 * 00027 * 00028 *> \par Purpose: 00029 * ============= 00030 *> 00031 *> \verbatim 00032 *> 00033 *> SCKGSV tests SGGSVD: 00034 *> the GSVD for M-by-N matrix A and P-by-N matrix B. 00035 *> \endverbatim 00036 * 00037 * Arguments: 00038 * ========== 00039 * 00040 *> \param[in] NM 00041 *> \verbatim 00042 *> NM is INTEGER 00043 *> The number of values of M contained in the vector MVAL. 00044 *> \endverbatim 00045 *> 00046 *> \param[in] MVAL 00047 *> \verbatim 00048 *> MVAL is INTEGER array, dimension (NM) 00049 *> The values of the matrix row dimension M. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] PVAL 00053 *> \verbatim 00054 *> PVAL is INTEGER array, dimension (NP) 00055 *> The values of the matrix row 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 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 REAL array, dimension (NMAX*NMAX) 00102 *> \endverbatim 00103 *> 00104 *> \param[out] AF 00105 *> \verbatim 00106 *> AF is REAL array, dimension (NMAX*NMAX) 00107 *> \endverbatim 00108 *> 00109 *> \param[out] B 00110 *> \verbatim 00111 *> B is REAL array, dimension (NMAX*NMAX) 00112 *> \endverbatim 00113 *> 00114 *> \param[out] BF 00115 *> \verbatim 00116 *> BF is REAL array, dimension (NMAX*NMAX) 00117 *> \endverbatim 00118 *> 00119 *> \param[out] U 00120 *> \verbatim 00121 *> U is REAL array, dimension (NMAX*NMAX) 00122 *> \endverbatim 00123 *> 00124 *> \param[out] V 00125 *> \verbatim 00126 *> V is REAL array, dimension (NMAX*NMAX) 00127 *> \endverbatim 00128 *> 00129 *> \param[out] Q 00130 *> \verbatim 00131 *> Q is REAL array, dimension (NMAX*NMAX) 00132 *> \endverbatim 00133 *> 00134 *> \param[out] ALPHA 00135 *> \verbatim 00136 *> ALPHA is REAL array, dimension (NMAX) 00137 *> \endverbatim 00138 *> 00139 *> \param[out] BETA 00140 *> \verbatim 00141 *> BETA is REAL array, dimension (NMAX) 00142 *> \endverbatim 00143 *> 00144 *> \param[out] R 00145 *> \verbatim 00146 *> R is REAL array, dimension (NMAX*NMAX) 00147 *> \endverbatim 00148 *> 00149 *> \param[out] IWORK 00150 *> \verbatim 00151 *> IWORK is INTEGER array, dimension (NMAX) 00152 *> \endverbatim 00153 *> 00154 *> \param[out] WORK 00155 *> \verbatim 00156 *> WORK is REAL array, dimension (NMAX*NMAX) 00157 *> \endverbatim 00158 *> 00159 *> \param[out] RWORK 00160 *> \verbatim 00161 *> RWORK is REAL array, dimension (NMAX) 00162 *> \endverbatim 00163 *> 00164 *> \param[in] NIN 00165 *> \verbatim 00166 *> NIN is INTEGER 00167 *> The unit number for input. 00168 *> \endverbatim 00169 *> 00170 *> \param[in] NOUT 00171 *> \verbatim 00172 *> NOUT is INTEGER 00173 *> The unit number for output. 00174 *> \endverbatim 00175 *> 00176 *> \param[out] INFO 00177 *> \verbatim 00178 *> INFO is INTEGER 00179 *> = 0 : successful exit 00180 *> > 0 : If SLATMS returns an error code, the absolute value 00181 *> of it is returned. 00182 *> \endverbatim 00183 * 00184 * Authors: 00185 * ======== 00186 * 00187 *> \author Univ. of Tennessee 00188 *> \author Univ. of California Berkeley 00189 *> \author Univ. of Colorado Denver 00190 *> \author NAG Ltd. 00191 * 00192 *> \date November 2011 00193 * 00194 *> \ingroup single_eig 00195 * 00196 * ===================================================================== 00197 SUBROUTINE SCKGSV( NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, 00198 $ NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R, 00199 $ IWORK, WORK, RWORK, NIN, NOUT, INFO ) 00200 * 00201 * -- LAPACK test routine (version 3.4.0) -- 00202 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00203 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00204 * November 2011 00205 * 00206 * .. Scalar Arguments .. 00207 INTEGER INFO, NIN, NM, NMATS, NMAX, NOUT 00208 REAL THRESH 00209 * .. 00210 * .. Array Arguments .. 00211 INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ), 00212 $ PVAL( * ) 00213 REAL A( * ), AF( * ), ALPHA( * ), B( * ), BETA( * ), 00214 $ BF( * ), Q( * ), R( * ), RWORK( * ), U( * ), 00215 $ V( * ), WORK( * ) 00216 * .. 00217 * 00218 * ===================================================================== 00219 * 00220 * .. Parameters .. 00221 INTEGER NTESTS 00222 PARAMETER ( NTESTS = 7 ) 00223 INTEGER NTYPES 00224 PARAMETER ( NTYPES = 8 ) 00225 * .. 00226 * .. Local Scalars .. 00227 LOGICAL FIRSTT 00228 CHARACTER DISTA, DISTB, TYPE 00229 CHARACTER*3 PATH 00230 INTEGER I, IINFO, IM, IMAT, KLA, KLB, KUA, KUB, LDA, 00231 $ LDB, LDQ, LDR, LDU, LDV, LWORK, M, MODEA, 00232 $ MODEB, N, NFAIL, NRUN, NT, P 00233 REAL ANORM, BNORM, CNDNMA, CNDNMB 00234 * .. 00235 * .. Local Arrays .. 00236 LOGICAL DOTYPE( NTYPES ) 00237 REAL RESULT( NTESTS ) 00238 * .. 00239 * .. External Subroutines .. 00240 EXTERNAL ALAHDG, ALAREQ, ALASUM, SGSVTS, SLATB9, SLATMS 00241 * .. 00242 * .. Intrinsic Functions .. 00243 INTRINSIC ABS 00244 * .. 00245 * .. Executable Statements .. 00246 * 00247 * Initialize constants and the random number seed. 00248 * 00249 PATH( 1: 3 ) = 'GSV' 00250 INFO = 0 00251 NRUN = 0 00252 NFAIL = 0 00253 FIRSTT = .TRUE. 00254 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00255 LDA = NMAX 00256 LDB = NMAX 00257 LDU = NMAX 00258 LDV = NMAX 00259 LDQ = NMAX 00260 LDR = NMAX 00261 LWORK = NMAX*NMAX 00262 * 00263 * Do for each value of M in MVAL. 00264 * 00265 DO 30 IM = 1, NM 00266 M = MVAL( IM ) 00267 P = PVAL( IM ) 00268 N = NVAL( IM ) 00269 * 00270 DO 20 IMAT = 1, NTYPES 00271 * 00272 * Do the tests only if DOTYPE( IMAT ) is true. 00273 * 00274 IF( .NOT.DOTYPE( IMAT ) ) 00275 $ GO TO 20 00276 * 00277 * Set up parameters with SLATB9 and generate test 00278 * matrices A and B with SLATMS. 00279 * 00280 CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, 00281 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, 00282 $ DISTA, DISTB ) 00283 * 00284 * Generate M by N matrix A 00285 * 00286 CALL SLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA, 00287 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK, 00288 $ IINFO ) 00289 IF( IINFO.NE.0 ) THEN 00290 WRITE( NOUT, FMT = 9999 )IINFO 00291 INFO = ABS( IINFO ) 00292 GO TO 20 00293 END IF 00294 * 00295 CALL SLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB, 00296 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK, 00297 $ IINFO ) 00298 IF( IINFO.NE.0 ) THEN 00299 WRITE( NOUT, FMT = 9999 )IINFO 00300 INFO = ABS( IINFO ) 00301 GO TO 20 00302 END IF 00303 * 00304 NT = 6 00305 * 00306 CALL SGSVTS( M, P, N, A, AF, LDA, B, BF, LDB, U, LDU, V, 00307 $ LDV, Q, LDQ, ALPHA, BETA, R, LDR, IWORK, WORK, 00308 $ LWORK, RWORK, RESULT ) 00309 * 00310 * Print information about the tests that did not 00311 * pass the threshold. 00312 * 00313 DO 10 I = 1, NT 00314 IF( RESULT( I ).GE.THRESH ) THEN 00315 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00316 FIRSTT = .FALSE. 00317 CALL ALAHDG( NOUT, PATH ) 00318 END IF 00319 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I, 00320 $ RESULT( I ) 00321 NFAIL = NFAIL + 1 00322 END IF 00323 10 CONTINUE 00324 NRUN = NRUN + NT 00325 20 CONTINUE 00326 30 CONTINUE 00327 * 00328 * Print a summary of the results. 00329 * 00330 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 ) 00331 * 00332 9999 FORMAT( ' SLATMS in SCKGSV INFO = ', I5 ) 00333 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2, 00334 $ ', test ', I2, ', ratio=', G13.6 ) 00335 RETURN 00336 * 00337 * End of SCKGSV 00338 * 00339 END