LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE ALADHD( IOUNIT, PATH ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER IOUNIT 00010 * .. 00011 * 00012 * Purpose 00013 * ======= 00014 * 00015 * ALADHD prints header information for the driver routines test paths. 00016 * 00017 * Arguments 00018 * ========= 00019 * 00020 * IOUNIT (input) INTEGER 00021 * The unit number to which the header information should be 00022 * printed. 00023 * 00024 * PATH (input) CHARACTER*3 00025 * The name of the path for which the header information is to 00026 * be printed. Current paths are 00027 * _GE: General matrices 00028 * _GB: General band 00029 * _GT: General Tridiagonal 00030 * _PO: Symmetric or Hermitian positive definite 00031 * _PS: Symmetric or Hermitian positive semi-definite 00032 * _PP: Symmetric or Hermitian positive definite packed 00033 * _PB: Symmetric or Hermitian positive definite band 00034 * _PT: Symmetric or Hermitian positive definite tridiagonal 00035 * _SY: Symmetric indefinite 00036 * _SP: Symmetric indefinite packed 00037 * _HE: (complex) Hermitian indefinite 00038 * _HP: (complex) Hermitian indefinite packed 00039 * The first character must be one of S, D, C, or Z (C or Z only 00040 * if complex). 00041 * 00042 * .. Local Scalars .. 00043 LOGICAL CORZ, SORD 00044 CHARACTER C1, C3 00045 CHARACTER*2 P2 00046 CHARACTER*9 SYM 00047 * .. 00048 * .. External Functions .. 00049 LOGICAL LSAME, LSAMEN 00050 EXTERNAL LSAME, LSAMEN 00051 * .. 00052 * .. Executable Statements .. 00053 * 00054 IF( IOUNIT.LE.0 ) 00055 $ RETURN 00056 C1 = PATH( 1: 1 ) 00057 C3 = PATH( 3: 3 ) 00058 P2 = PATH( 2: 3 ) 00059 SORD = LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' ) 00060 CORZ = LSAME( C1, 'C' ) .OR. LSAME( C1, 'Z' ) 00061 IF( .NOT.( SORD .OR. CORZ ) ) 00062 $ RETURN 00063 * 00064 IF( LSAMEN( 2, P2, 'GE' ) ) THEN 00065 * 00066 * GE: General dense 00067 * 00068 WRITE( IOUNIT, FMT = 9999 )PATH 00069 WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) 00070 WRITE( IOUNIT, FMT = 9989 ) 00071 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00072 WRITE( IOUNIT, FMT = 9981 )1 00073 WRITE( IOUNIT, FMT = 9980 )2 00074 WRITE( IOUNIT, FMT = 9979 )3 00075 WRITE( IOUNIT, FMT = 9978 )4 00076 WRITE( IOUNIT, FMT = 9977 )5 00077 WRITE( IOUNIT, FMT = 9976 )6 00078 WRITE( IOUNIT, FMT = 9972 )7 00079 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00080 * 00081 ELSE IF( LSAMEN( 2, P2, 'GB' ) ) THEN 00082 * 00083 * GB: General band 00084 * 00085 WRITE( IOUNIT, FMT = 9998 )PATH 00086 WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) 00087 WRITE( IOUNIT, FMT = 9988 ) 00088 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00089 WRITE( IOUNIT, FMT = 9981 )1 00090 WRITE( IOUNIT, FMT = 9980 )2 00091 WRITE( IOUNIT, FMT = 9979 )3 00092 WRITE( IOUNIT, FMT = 9978 )4 00093 WRITE( IOUNIT, FMT = 9977 )5 00094 WRITE( IOUNIT, FMT = 9976 )6 00095 WRITE( IOUNIT, FMT = 9972 )7 00096 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00097 * 00098 ELSE IF( LSAMEN( 2, P2, 'GT' ) ) THEN 00099 * 00100 * GT: General tridiagonal 00101 * 00102 WRITE( IOUNIT, FMT = 9997 )PATH 00103 WRITE( IOUNIT, FMT = 9987 ) 00104 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00105 WRITE( IOUNIT, FMT = 9981 )1 00106 WRITE( IOUNIT, FMT = 9980 )2 00107 WRITE( IOUNIT, FMT = 9979 )3 00108 WRITE( IOUNIT, FMT = 9978 )4 00109 WRITE( IOUNIT, FMT = 9977 )5 00110 WRITE( IOUNIT, FMT = 9976 )6 00111 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00112 * 00113 ELSE IF( LSAMEN( 2, P2, 'PO' ) .OR. LSAMEN( 2, P2, 'PP' ) 00114 $ .OR. LSAMEN( 2, P2, 'PS' ) ) THEN 00115 * 00116 * PO: Positive definite full 00117 * PS: Positive definite full 00118 * PP: Positive definite packed 00119 * 00120 IF( SORD ) THEN 00121 SYM = 'Symmetric' 00122 ELSE 00123 SYM = 'Hermitian' 00124 END IF 00125 IF( LSAME( C3, 'O' ) ) THEN 00126 WRITE( IOUNIT, FMT = 9996 )PATH, SYM 00127 ELSE 00128 WRITE( IOUNIT, FMT = 9995 )PATH, SYM 00129 END IF 00130 WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) 00131 WRITE( IOUNIT, FMT = 9985 )PATH 00132 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00133 WRITE( IOUNIT, FMT = 9975 )1 00134 WRITE( IOUNIT, FMT = 9980 )2 00135 WRITE( IOUNIT, FMT = 9979 )3 00136 WRITE( IOUNIT, FMT = 9978 )4 00137 WRITE( IOUNIT, FMT = 9977 )5 00138 WRITE( IOUNIT, FMT = 9976 )6 00139 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00140 * 00141 ELSE IF( LSAMEN( 2, P2, 'PB' ) ) THEN 00142 * 00143 * PB: Positive definite band 00144 * 00145 IF( SORD ) THEN 00146 WRITE( IOUNIT, FMT = 9994 )PATH, 'Symmetric' 00147 ELSE 00148 WRITE( IOUNIT, FMT = 9994 )PATH, 'Hermitian' 00149 END IF 00150 WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) 00151 WRITE( IOUNIT, FMT = 9984 )PATH 00152 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00153 WRITE( IOUNIT, FMT = 9975 )1 00154 WRITE( IOUNIT, FMT = 9980 )2 00155 WRITE( IOUNIT, FMT = 9979 )3 00156 WRITE( IOUNIT, FMT = 9978 )4 00157 WRITE( IOUNIT, FMT = 9977 )5 00158 WRITE( IOUNIT, FMT = 9976 )6 00159 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00160 * 00161 ELSE IF( LSAMEN( 2, P2, 'PT' ) ) THEN 00162 * 00163 * PT: Positive definite tridiagonal 00164 * 00165 IF( SORD ) THEN 00166 WRITE( IOUNIT, FMT = 9993 )PATH, 'Symmetric' 00167 ELSE 00168 WRITE( IOUNIT, FMT = 9993 )PATH, 'Hermitian' 00169 END IF 00170 WRITE( IOUNIT, FMT = 9986 ) 00171 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00172 WRITE( IOUNIT, FMT = 9973 )1 00173 WRITE( IOUNIT, FMT = 9980 )2 00174 WRITE( IOUNIT, FMT = 9979 )3 00175 WRITE( IOUNIT, FMT = 9978 )4 00176 WRITE( IOUNIT, FMT = 9977 )5 00177 WRITE( IOUNIT, FMT = 9976 )6 00178 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00179 * 00180 ELSE IF( LSAMEN( 2, P2, 'SY' ) .OR. LSAMEN( 2, P2, 'SP' ) ) THEN 00181 * 00182 * SY: Symmetric indefinite full 00183 * SP: Symmetric indefinite packed 00184 * 00185 IF( LSAME( C3, 'Y' ) ) THEN 00186 WRITE( IOUNIT, FMT = 9992 )PATH, 'Symmetric' 00187 ELSE 00188 WRITE( IOUNIT, FMT = 9991 )PATH, 'Symmetric' 00189 END IF 00190 WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) 00191 IF( SORD ) THEN 00192 WRITE( IOUNIT, FMT = 9983 ) 00193 ELSE 00194 WRITE( IOUNIT, FMT = 9982 ) 00195 END IF 00196 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00197 WRITE( IOUNIT, FMT = 9974 )1 00198 WRITE( IOUNIT, FMT = 9980 )2 00199 WRITE( IOUNIT, FMT = 9979 )3 00200 WRITE( IOUNIT, FMT = 9977 )4 00201 WRITE( IOUNIT, FMT = 9978 )5 00202 WRITE( IOUNIT, FMT = 9976 )6 00203 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00204 * 00205 ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. LSAMEN( 2, P2, 'HP' ) ) THEN 00206 * 00207 * HE: Hermitian indefinite full 00208 * HP: Hermitian indefinite packed 00209 * 00210 IF( LSAME( C3, 'E' ) ) THEN 00211 WRITE( IOUNIT, FMT = 9992 )PATH, 'Hermitian' 00212 ELSE 00213 WRITE( IOUNIT, FMT = 9991 )PATH, 'Hermitian' 00214 END IF 00215 WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' ) 00216 WRITE( IOUNIT, FMT = 9983 ) 00217 WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' ) 00218 WRITE( IOUNIT, FMT = 9974 )1 00219 WRITE( IOUNIT, FMT = 9980 )2 00220 WRITE( IOUNIT, FMT = 9979 )3 00221 WRITE( IOUNIT, FMT = 9977 )4 00222 WRITE( IOUNIT, FMT = 9978 )5 00223 WRITE( IOUNIT, FMT = 9976 )6 00224 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) 00225 * 00226 ELSE 00227 * 00228 * Print error message if no header is available. 00229 * 00230 WRITE( IOUNIT, FMT = 9990 )PATH 00231 END IF 00232 * 00233 * First line of header 00234 * 00235 9999 FORMAT( / 1X, A3, ' drivers: General dense matrices' ) 00236 9998 FORMAT( / 1X, A3, ' drivers: General band matrices' ) 00237 9997 FORMAT( / 1X, A3, ' drivers: General tridiagonal' ) 00238 9996 FORMAT( / 1X, A3, ' drivers: ', A9, 00239 $ ' positive definite matrices' ) 00240 9995 FORMAT( / 1X, A3, ' drivers: ', A9, 00241 $ ' positive definite packed matrices' ) 00242 9994 FORMAT( / 1X, A3, ' drivers: ', A9, 00243 $ ' positive definite band matrices' ) 00244 9993 FORMAT( / 1X, A3, ' drivers: ', A9, 00245 $ ' positive definite tridiagonal' ) 00246 9992 FORMAT( / 1X, A3, ' drivers: ', A9, ' indefinite matrices' ) 00247 9991 FORMAT( / 1X, A3, ' drivers: ', A9, 00248 $ ' indefinite packed matrices' ) 00249 9990 FORMAT( / 1X, A3, ': No header available' ) 00250 * 00251 * GE matrix types 00252 * 00253 9989 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X, 00254 $ '2. Upper triangular', 16X, 00255 $ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, 00256 $ '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS', 00257 $ / 4X, '4. Random, CNDNUM = 2', 13X, 00258 $ '10. Scaled near underflow', / 4X, '5. First column zero', 00259 $ 14X, '11. Scaled near overflow', / 4X, 00260 $ '6. Last column zero' ) 00261 * 00262 * GB matrix types 00263 * 00264 9988 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X, 00265 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, 00266 $ '2. First column zero', 15X, '6. Random, CNDNUM = 0.1/EPS', 00267 $ / 4X, '3. Last column zero', 16X, 00268 $ '7. Scaled near underflow', / 4X, 00269 $ '4. Last n/2 columns zero', 11X, '8. Scaled near overflow' ) 00270 * 00271 * GT matrix types 00272 * 00273 9987 FORMAT( ' Matrix types (1-6 have specified condition numbers):', 00274 $ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM', 00275 $ / 4X, '2. Random, CNDNUM = 2', 14X, '8. First column zero', 00276 $ / 4X, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X, 00277 $ '9. Last column zero', / 4X, '4. Random, CNDNUM = 0.1/EPS', 00278 $ 7X, '10. Last n/2 columns zero', / 4X, 00279 $ '5. Scaled near underflow', 10X, 00280 $ '11. Scaled near underflow', / 4X, 00281 $ '6. Scaled near overflow', 11X, '12. Scaled near overflow' ) 00282 * 00283 * PT matrix types 00284 * 00285 9986 FORMAT( ' Matrix types (1-6 have specified condition numbers):', 00286 $ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM', 00287 $ / 4X, '2. Random, CNDNUM = 2', 14X, 00288 $ '8. First row and column zero', / 4X, 00289 $ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X, 00290 $ '9. Last row and column zero', / 4X, 00291 $ '4. Random, CNDNUM = 0.1/EPS', 7X, 00292 $ '10. Middle row and column zero', / 4X, 00293 $ '5. Scaled near underflow', 10X, 00294 $ '11. Scaled near underflow', / 4X, 00295 $ '6. Scaled near overflow', 11X, '12. Scaled near overflow' ) 00296 * 00297 * PO, PP matrix types 00298 * 00299 9985 FORMAT( 4X, '1. Diagonal', 24X, 00300 $ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, 00301 $ '2. Random, CNDNUM = 2', 14X, '7. Random, CNDNUM = 0.1/EPS', 00302 $ / 3X, '*3. First row and column zero', 7X, 00303 $ '8. Scaled near underflow', / 3X, 00304 $ '*4. Last row and column zero', 8X, 00305 $ '9. Scaled near overflow', / 3X, 00306 $ '*5. Middle row and column zero', / 3X, 00307 $ '(* - tests error exits from ', A3, 00308 $ 'TRF, no test ratios are computed)' ) 00309 * 00310 * PB matrix types 00311 * 00312 9984 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X, 00313 $ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3X, 00314 $ '*2. First row and column zero', 7X, 00315 $ '6. Random, CNDNUM = 0.1/EPS', / 3X, 00316 $ '*3. Last row and column zero', 8X, 00317 $ '7. Scaled near underflow', / 3X, 00318 $ '*4. Middle row and column zero', 6X, 00319 $ '8. Scaled near overflow', / 3X, 00320 $ '(* - tests error exits from ', A3, 00321 $ 'TRF, no test ratios are computed)' ) 00322 * 00323 * SSY, SSP, CHE, CHP matrix types 00324 * 00325 9983 FORMAT( 4X, '1. Diagonal', 24X, 00326 $ '6. Last n/2 rows and columns zero', / 4X, 00327 $ '2. Random, CNDNUM = 2', 14X, 00328 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, 00329 $ '3. First row and column zero', 7X, 00330 $ '8. Random, CNDNUM = 0.1/EPS', / 4X, 00331 $ '4. Last row and column zero', 8X, 00332 $ '9. Scaled near underflow', / 4X, 00333 $ '5. Middle row and column zero', 5X, 00334 $ '10. Scaled near overflow' ) 00335 * 00336 * CSY, CSP matrix types 00337 * 00338 9982 FORMAT( 4X, '1. Diagonal', 24X, 00339 $ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X, 00340 $ '2. Random, CNDNUM = 2', 14X, '8. Random, CNDNUM = 0.1/EPS', 00341 $ / 4X, '3. First row and column zero', 7X, 00342 $ '9. Scaled near underflow', / 4X, 00343 $ '4. Last row and column zero', 7X, 00344 $ '10. Scaled near overflow', / 4X, 00345 $ '5. Middle row and column zero', 5X, 00346 $ '11. Block diagonal matrix', / 4X, 00347 $ '6. Last n/2 rows and columns zero' ) 00348 * 00349 * Test ratios 00350 * 00351 9981 FORMAT( 3X, I2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' ) 00352 9980 FORMAT( 3X, I2, ': norm( B - A * X ) / ', 00353 $ '( norm(A) * norm(X) * EPS )' ) 00354 9979 FORMAT( 3X, I2, ': norm( X - XACT ) / ', 00355 $ '( norm(XACT) * CNDNUM * EPS )' ) 00356 9978 FORMAT( 3X, I2, ': norm( X - XACT ) / ', 00357 $ '( norm(XACT) * (error bound) )' ) 00358 9977 FORMAT( 3X, I2, ': (backward error) / EPS' ) 00359 9976 FORMAT( 3X, I2, ': RCOND * CNDNUM - 1.0' ) 00360 9975 FORMAT( 3X, I2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )', 00361 $ ', or', / 7X, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )' 00362 $ ) 00363 9974 FORMAT( 3X, I2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )', 00364 $ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )' 00365 $ ) 00366 9973 FORMAT( 3X, I2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )', 00367 $ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )' 00368 $ ) 00369 9972 FORMAT( 3X, I2, ': abs( WORK(1) - RPVGRW ) /', 00370 $ ' ( max( WORK(1), RPVGRW ) * EPS )' ) 00371 * 00372 RETURN 00373 * 00374 * End of ALADHD 00375 * 00376 END