|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE SCKGSV( NM, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, 00002 $ NMAX, A, AF, B, BF, U, V, Q, ALPHA, BETA, R, 00003 $ IWORK, 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, NOUT 00011 REAL THRESH 00012 * .. 00013 * .. Array Arguments .. 00014 INTEGER ISEED( 4 ), IWORK( * ), MVAL( * ), NVAL( * ), 00015 $ PVAL( * ) 00016 REAL A( * ), AF( * ), ALPHA( * ), B( * ), BETA( * ), 00017 $ BF( * ), Q( * ), R( * ), RWORK( * ), U( * ), 00018 $ V( * ), WORK( * ) 00019 * .. 00020 * 00021 * Purpose 00022 * ======= 00023 * 00024 * SCKGSV tests SGGSVD: 00025 * the GSVD for M-by-N matrix A and P-by-N matrix B. 00026 * 00027 * Arguments 00028 * ========= 00029 * 00030 * NM (input) INTEGER 00031 * The number of values of M contained in the vector MVAL. 00032 * 00033 * MVAL (input) INTEGER array, dimension (NM) 00034 * The values of the matrix row dimension M. 00035 * 00036 * PVAL (input) INTEGER array, dimension (NP) 00037 * The values of the matrix row dimension P. 00038 * 00039 * NVAL (input) INTEGER array, dimension (NN) 00040 * The values of the matrix column dimension N. 00041 * 00042 * NMATS (input) INTEGER 00043 * The number of matrix types to be tested for each combination 00044 * of matrix dimensions. If NMATS >= NTYPES (the maximum 00045 * number of matrix types), then all the different types are 00046 * generated for testing. If NMATS < NTYPES, another input line 00047 * is read to get the numbers of the matrix types to be used. 00048 * 00049 * ISEED (input/output) INTEGER array, dimension (4) 00050 * On entry, the seed of the random number generator. The array 00051 * elements should be between 0 and 4095, otherwise they will be 00052 * reduced mod 4096, and ISEED(4) must be odd. 00053 * On exit, the next seed in the random number sequence after 00054 * all the test matrices have been generated. 00055 * 00056 * THRESH (input) REAL 00057 * The threshold value for the test ratios. A result is 00058 * included in the output file if RESULT >= THRESH. To have 00059 * every test ratio printed, use THRESH = 0. 00060 * 00061 * NMAX (input) INTEGER 00062 * The maximum value permitted for M or N, used in dimensioning 00063 * the work arrays. 00064 * 00065 * A (workspace) REAL array, dimension (NMAX*NMAX) 00066 * 00067 * AF (workspace) REAL array, dimension (NMAX*NMAX) 00068 * 00069 * B (workspace) REAL array, dimension (NMAX*NMAX) 00070 * 00071 * BF (workspace) REAL array, dimension (NMAX*NMAX) 00072 * 00073 * U (workspace) REAL array, dimension (NMAX*NMAX) 00074 * 00075 * V (workspace) REAL array, dimension (NMAX*NMAX) 00076 * 00077 * Q (workspace) REAL array, dimension (NMAX*NMAX) 00078 * 00079 * ALPHA (workspace) REAL array, dimension (NMAX) 00080 * 00081 * BETA (workspace) REAL array, dimension (NMAX) 00082 * 00083 * R (workspace) REAL array, dimension (NMAX*NMAX) 00084 * 00085 * IWORK (workspace) INTEGER array, dimension (NMAX) 00086 * 00087 * WORK (workspace) REAL array, dimension (NMAX*NMAX) 00088 * 00089 * RWORK (workspace) REAL array, dimension (NMAX) 00090 * 00091 * NIN (input) INTEGER 00092 * The unit number for input. 00093 * 00094 * NOUT (input) INTEGER 00095 * The unit number for output. 00096 * 00097 * INFO (output) INTEGER 00098 * = 0 : successful exit 00099 * > 0 : If SLATMS returns an error code, the absolute value 00100 * of it is returned. 00101 * 00102 * ===================================================================== 00103 * 00104 * .. Parameters .. 00105 INTEGER NTESTS 00106 PARAMETER ( NTESTS = 7 ) 00107 INTEGER NTYPES 00108 PARAMETER ( NTYPES = 8 ) 00109 * .. 00110 * .. Local Scalars .. 00111 LOGICAL FIRSTT 00112 CHARACTER DISTA, DISTB, TYPE 00113 CHARACTER*3 PATH 00114 INTEGER I, IINFO, IM, IMAT, KLA, KLB, KUA, KUB, LDA, 00115 $ LDB, LDQ, LDR, LDU, LDV, LWORK, M, MODEA, 00116 $ MODEB, N, NFAIL, NRUN, NT, P 00117 REAL ANORM, BNORM, CNDNMA, CNDNMB 00118 * .. 00119 * .. Local Arrays .. 00120 LOGICAL DOTYPE( NTYPES ) 00121 REAL RESULT( NTESTS ) 00122 * .. 00123 * .. External Subroutines .. 00124 EXTERNAL ALAHDG, ALAREQ, ALASUM, SGSVTS, SLATB9, SLATMS 00125 * .. 00126 * .. Intrinsic Functions .. 00127 INTRINSIC ABS 00128 * .. 00129 * .. Executable Statements .. 00130 * 00131 * Initialize constants and the random number seed. 00132 * 00133 PATH( 1: 3 ) = 'GSV' 00134 INFO = 0 00135 NRUN = 0 00136 NFAIL = 0 00137 FIRSTT = .TRUE. 00138 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00139 LDA = NMAX 00140 LDB = NMAX 00141 LDU = NMAX 00142 LDV = NMAX 00143 LDQ = NMAX 00144 LDR = NMAX 00145 LWORK = NMAX*NMAX 00146 * 00147 * Do for each value of M in MVAL. 00148 * 00149 DO 30 IM = 1, NM 00150 M = MVAL( IM ) 00151 P = PVAL( IM ) 00152 N = NVAL( IM ) 00153 * 00154 DO 20 IMAT = 1, NTYPES 00155 * 00156 * Do the tests only if DOTYPE( IMAT ) is true. 00157 * 00158 IF( .NOT.DOTYPE( IMAT ) ) 00159 $ GO TO 20 00160 * 00161 * Set up parameters with SLATB9 and generate test 00162 * matrices A and B with SLATMS. 00163 * 00164 CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, 00165 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, 00166 $ DISTA, DISTB ) 00167 * 00168 * Generate M by N matrix A 00169 * 00170 CALL SLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA, 00171 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK, 00172 $ IINFO ) 00173 IF( IINFO.NE.0 ) THEN 00174 WRITE( NOUT, FMT = 9999 )IINFO 00175 INFO = ABS( IINFO ) 00176 GO TO 20 00177 END IF 00178 * 00179 CALL SLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB, 00180 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK, 00181 $ IINFO ) 00182 IF( IINFO.NE.0 ) THEN 00183 WRITE( NOUT, FMT = 9999 )IINFO 00184 INFO = ABS( IINFO ) 00185 GO TO 20 00186 END IF 00187 * 00188 NT = 6 00189 * 00190 CALL SGSVTS( M, P, N, A, AF, LDA, B, BF, LDB, U, LDU, V, 00191 $ LDV, Q, LDQ, ALPHA, BETA, R, LDR, IWORK, WORK, 00192 $ LWORK, RWORK, RESULT ) 00193 * 00194 * Print information about the tests that did not 00195 * pass the threshold. 00196 * 00197 DO 10 I = 1, NT 00198 IF( RESULT( I ).GE.THRESH ) THEN 00199 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00200 FIRSTT = .FALSE. 00201 CALL ALAHDG( NOUT, PATH ) 00202 END IF 00203 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I, 00204 $ RESULT( I ) 00205 NFAIL = NFAIL + 1 00206 END IF 00207 10 CONTINUE 00208 NRUN = NRUN + NT 00209 20 CONTINUE 00210 30 CONTINUE 00211 * 00212 * Print a summary of the results. 00213 * 00214 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 ) 00215 * 00216 9999 FORMAT( ' SLATMS in SCKGSV INFO = ', I5 ) 00217 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2, 00218 $ ', test ', I2, ', ratio=', G13.6 ) 00219 RETURN 00220 * 00221 * End of SCKGSV 00222 * 00223 END
1.7.3 
