|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CCKLSE( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH, 00002 $ NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT, 00003 $ 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, NMATS, NMAX, NN, NOUT 00011 REAL THRESH 00012 * .. 00013 * .. Array Arguments .. 00014 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * ) 00015 REAL RWORK( * ) 00016 COMPLEX A( * ), AF( * ), B( * ), BF( * ), WORK( * ), 00017 $ X( * ) 00018 * .. 00019 * 00020 * Purpose 00021 * ======= 00022 * 00023 * CCKLSE tests CGGLSE - a subroutine for solving linear equality 00024 * constrained least square problem (LSE). 00025 * 00026 * Arguments 00027 * ========= 00028 * 00029 * NN (input) INTEGER 00030 * The number of values of (M,P,N) contained in the vectors 00031 * (MVAL, PVAL, NVAL). 00032 * 00033 * MVAL (input) INTEGER array, dimension (NN) 00034 * The values of the matrix row(column) dimension M. 00035 * 00036 * PVAL (input) INTEGER array, dimension (NN) 00037 * The values of the matrix row(column) dimension P. 00038 * 00039 * NVAL (input) INTEGER array, dimension (NN) 00040 * The values of the matrix column(row) 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) COMPLEX array, dimension (NMAX*NMAX) 00066 * 00067 * AF (workspace) COMPLEX array, dimension (NMAX*NMAX) 00068 * 00069 * B (workspace) COMPLEX array, dimension (NMAX*NMAX) 00070 * 00071 * BF (workspace) COMPLEX array, dimension (NMAX*NMAX) 00072 * 00073 * X (workspace) COMPLEX array, dimension (5*NMAX) 00074 * 00075 * WORK (workspace) COMPLEX array, dimension (NMAX*NMAX) 00076 * 00077 * RWORK (workspace) REAL array, dimension (NMAX) 00078 * 00079 * NIN (input) INTEGER 00080 * The unit number for input. 00081 * 00082 * NOUT (input) INTEGER 00083 * The unit number for output. 00084 * 00085 * INFO (output) INTEGER 00086 * = 0 : successful exit 00087 * > 0 : If CLATMS returns an error code, the absolute value 00088 * of it is returned. 00089 * 00090 * ===================================================================== 00091 * 00092 * .. Parameters .. 00093 INTEGER NTESTS 00094 PARAMETER ( NTESTS = 7 ) 00095 INTEGER NTYPES 00096 PARAMETER ( NTYPES = 8 ) 00097 * .. 00098 * .. Local Scalars .. 00099 LOGICAL FIRSTT 00100 CHARACTER DISTA, DISTB, TYPE 00101 CHARACTER*3 PATH 00102 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA, 00103 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN, 00104 $ NT, P 00105 REAL ANORM, BNORM, CNDNMA, CNDNMB 00106 * .. 00107 * .. Local Arrays .. 00108 LOGICAL DOTYPE( NTYPES ) 00109 REAL RESULT( NTESTS ) 00110 * .. 00111 * .. External Subroutines .. 00112 EXTERNAL ALAHDG, ALAREQ, ALASUM, CLARHS, CLATMS, CLSETS, 00113 $ SLATB9 00114 * .. 00115 * .. Intrinsic Functions .. 00116 INTRINSIC ABS, MAX 00117 * .. 00118 * .. Executable Statements .. 00119 * 00120 * Initialize constants and the random number seed. 00121 * 00122 PATH( 1: 3 ) = 'LSE' 00123 INFO = 0 00124 NRUN = 0 00125 NFAIL = 0 00126 FIRSTT = .TRUE. 00127 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00128 LDA = NMAX 00129 LDB = NMAX 00130 LWORK = NMAX*NMAX 00131 * 00132 * Check for valid input values. 00133 * 00134 DO 10 IK = 1, NN 00135 M = MVAL( IK ) 00136 P = PVAL( IK ) 00137 N = NVAL( IK ) 00138 IF( P.GT.N .OR. N.GT.M+P ) THEN 00139 IF( FIRSTT ) THEN 00140 WRITE( NOUT, FMT = * ) 00141 FIRSTT = .FALSE. 00142 END IF 00143 WRITE( NOUT, FMT = 9997 )M, P, N 00144 END IF 00145 10 CONTINUE 00146 FIRSTT = .TRUE. 00147 * 00148 * Do for each value of M in MVAL. 00149 * 00150 DO 40 IK = 1, NN 00151 M = MVAL( IK ) 00152 P = PVAL( IK ) 00153 N = NVAL( IK ) 00154 IF( P.GT.N .OR. N.GT.M+P ) 00155 $ GO TO 40 00156 * 00157 DO 30 IMAT = 1, NTYPES 00158 * 00159 * Do the tests only if DOTYPE( IMAT ) is true. 00160 * 00161 IF( .NOT.DOTYPE( IMAT ) ) 00162 $ GO TO 30 00163 * 00164 * Set up parameters with SLATB9 and generate test 00165 * matrices A and B with CLATMS. 00166 * 00167 CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, 00168 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, 00169 $ DISTA, DISTB ) 00170 * 00171 CALL CLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA, 00172 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK, 00173 $ IINFO ) 00174 IF( IINFO.NE.0 ) THEN 00175 WRITE( NOUT, FMT = 9999 )IINFO 00176 INFO = ABS( IINFO ) 00177 GO TO 30 00178 END IF 00179 * 00180 CALL CLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB, 00181 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK, 00182 $ IINFO ) 00183 IF( IINFO.NE.0 ) THEN 00184 WRITE( NOUT, FMT = 9999 )IINFO 00185 INFO = ABS( IINFO ) 00186 GO TO 30 00187 END IF 00188 * 00189 * Generate the right-hand sides C and D for the LSE. 00190 * 00191 CALL CLARHS( 'CGE', 'New solution', 'Upper', 'N', M, N, 00192 $ MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA, 00193 $ X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ), 00194 $ ISEED, IINFO ) 00195 * 00196 CALL CLARHS( 'CGE', 'Computed', 'Upper', 'N', P, N, 00197 $ MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB, 00198 $ X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ), 00199 $ MAX( P, 1 ), ISEED, IINFO ) 00200 * 00201 NT = 2 00202 * 00203 CALL CLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X, 00204 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ), 00205 $ X( 4*NMAX+1 ), WORK, LWORK, RWORK, 00206 $ RESULT( 1 ) ) 00207 * 00208 * Print information about the tests that did not 00209 * pass the threshold. 00210 * 00211 DO 20 I = 1, NT 00212 IF( RESULT( I ).GE.THRESH ) THEN 00213 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN 00214 FIRSTT = .FALSE. 00215 CALL ALAHDG( NOUT, PATH ) 00216 END IF 00217 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I, 00218 $ RESULT( I ) 00219 NFAIL = NFAIL + 1 00220 END IF 00221 20 CONTINUE 00222 NRUN = NRUN + NT 00223 * 00224 30 CONTINUE 00225 40 CONTINUE 00226 * 00227 * Print a summary of the results. 00228 * 00229 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 ) 00230 * 00231 9999 FORMAT( ' CLATMS in CCKLSE INFO = ', I5 ) 00232 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2, 00233 $ ', test ', I2, ', ratio=', G13.6 ) 00234 9997 FORMAT( ' *** Invalid input for LSE: M = ', I6, ', P = ', I6, 00235 $ ', N = ', I6, ';', / ' must satisfy P <= N <= P+M ', 00236 $ '(this set of values will be skipped)' ) 00237 RETURN 00238 * 00239 * End of CCKLSE 00240 * 00241 END
1.7.3 
