|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE ALAHDG( IOUNIT, PATH ) 00002 * 00003 * -- LAPACK test routine (version 3.1.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 * ALAHDG prints header information for the different 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 * GQR: GQR (general matrices) 00028 * GRQ: GRQ (general matrices) 00029 * LSE: LSE Problem 00030 * GLM: GLM Problem 00031 * GSV: Generalized Singular Value Decomposition 00032 * CSD: CS Decomposition 00033 * 00034 * ===================================================================== 00035 * 00036 * .. Local Scalars .. 00037 CHARACTER*3 C2 00038 INTEGER ITYPE 00039 * .. 00040 * .. External Functions .. 00041 LOGICAL LSAMEN 00042 EXTERNAL LSAMEN 00043 * .. 00044 * .. Executable Statements .. 00045 * 00046 IF( IOUNIT.LE.0 ) 00047 $ RETURN 00048 C2 = PATH( 1: 3 ) 00049 * 00050 * First line describing matrices in this path 00051 * 00052 IF( LSAMEN( 3, C2, 'GQR' ) ) THEN 00053 ITYPE = 1 00054 WRITE( IOUNIT, FMT = 9991 )PATH 00055 ELSE IF( LSAMEN( 3, C2, 'GRQ' ) ) THEN 00056 ITYPE = 2 00057 WRITE( IOUNIT, FMT = 9992 )PATH 00058 ELSE IF( LSAMEN( 3, C2, 'LSE' ) ) THEN 00059 ITYPE = 3 00060 WRITE( IOUNIT, FMT = 9993 )PATH 00061 ELSE IF( LSAMEN( 3, C2, 'GLM' ) ) THEN 00062 ITYPE = 4 00063 WRITE( IOUNIT, FMT = 9994 )PATH 00064 ELSE IF( LSAMEN( 3, C2, 'GSV' ) ) THEN 00065 ITYPE = 5 00066 WRITE( IOUNIT, FMT = 9995 )PATH 00067 ELSE IF( LSAMEN( 3, C2, 'CSD' ) ) THEN 00068 ITYPE = 6 00069 WRITE( IOUNIT, FMT = 9996 )PATH 00070 END IF 00071 * 00072 * Matrix types 00073 * 00074 WRITE( IOUNIT, FMT = 9999 )'Matrix types: ' 00075 * 00076 IF( ITYPE.EQ.1 )THEN 00077 WRITE( IOUNIT, FMT = 9950 )1 00078 WRITE( IOUNIT, FMT = 9952 )2 00079 WRITE( IOUNIT, FMT = 9954 )3 00080 WRITE( IOUNIT, FMT = 9955 )4 00081 WRITE( IOUNIT, FMT = 9956 )5 00082 WRITE( IOUNIT, FMT = 9957 )6 00083 WRITE( IOUNIT, FMT = 9961 )7 00084 WRITE( IOUNIT, FMT = 9962 )8 00085 ELSE IF( ITYPE.EQ.2 )THEN 00086 WRITE( IOUNIT, FMT = 9951 )1 00087 WRITE( IOUNIT, FMT = 9953 )2 00088 WRITE( IOUNIT, FMT = 9954 )3 00089 WRITE( IOUNIT, FMT = 9955 )4 00090 WRITE( IOUNIT, FMT = 9956 )5 00091 WRITE( IOUNIT, FMT = 9957 )6 00092 WRITE( IOUNIT, FMT = 9961 )7 00093 WRITE( IOUNIT, FMT = 9962 )8 00094 ELSE IF( ITYPE.EQ.3 )THEN 00095 WRITE( IOUNIT, FMT = 9950 )1 00096 WRITE( IOUNIT, FMT = 9952 )2 00097 WRITE( IOUNIT, FMT = 9954 )3 00098 WRITE( IOUNIT, FMT = 9955 )4 00099 WRITE( IOUNIT, FMT = 9955 )5 00100 WRITE( IOUNIT, FMT = 9955 )6 00101 WRITE( IOUNIT, FMT = 9955 )7 00102 WRITE( IOUNIT, FMT = 9955 )8 00103 ELSE IF( ITYPE.EQ.4 )THEN 00104 WRITE( IOUNIT, FMT = 9951 )1 00105 WRITE( IOUNIT, FMT = 9953 )2 00106 WRITE( IOUNIT, FMT = 9954 )3 00107 WRITE( IOUNIT, FMT = 9955 )4 00108 WRITE( IOUNIT, FMT = 9955 )5 00109 WRITE( IOUNIT, FMT = 9955 )6 00110 WRITE( IOUNIT, FMT = 9955 )7 00111 WRITE( IOUNIT, FMT = 9955 )8 00112 ELSE IF( ITYPE.EQ.5 )THEN 00113 WRITE( IOUNIT, FMT = 9950 )1 00114 WRITE( IOUNIT, FMT = 9952 )2 00115 WRITE( IOUNIT, FMT = 9954 )3 00116 WRITE( IOUNIT, FMT = 9955 )4 00117 WRITE( IOUNIT, FMT = 9956 )5 00118 WRITE( IOUNIT, FMT = 9957 )6 00119 WRITE( IOUNIT, FMT = 9959 )7 00120 WRITE( IOUNIT, FMT = 9960 )8 00121 ELSE IF( ITYPE.EQ.6 )THEN 00122 WRITE( IOUNIT, FMT = 9963 )1 00123 WRITE( IOUNIT, FMT = 9964 )2 00124 WRITE( IOUNIT, FMT = 9965 )3 00125 END IF 00126 * 00127 * Tests performed 00128 * 00129 WRITE( IOUNIT, FMT = 9999 )'Test ratios: ' 00130 * 00131 IF( ITYPE.EQ.1 ) THEN 00132 * 00133 * GQR decomposition of rectangular matrices 00134 * 00135 WRITE( IOUNIT, FMT = 9930 )1 00136 WRITE( IOUNIT, FMT = 9931 )2 00137 WRITE( IOUNIT, FMT = 9932 )3 00138 WRITE( IOUNIT, FMT = 9933 )4 00139 ELSE IF( ITYPE.EQ.2 ) THEN 00140 * 00141 * GRQ decomposition of rectangular matrices 00142 * 00143 WRITE( IOUNIT, FMT = 9934 )1 00144 WRITE( IOUNIT, FMT = 9935 )2 00145 WRITE( IOUNIT, FMT = 9932 )3 00146 WRITE( IOUNIT, FMT = 9933 )4 00147 ELSE IF( ITYPE.EQ.3 ) THEN 00148 * 00149 * LSE Problem 00150 * 00151 WRITE( IOUNIT, FMT = 9937 )1 00152 WRITE( IOUNIT, FMT = 9938 )2 00153 ELSE IF( ITYPE.EQ.4 ) THEN 00154 * 00155 * GLM Problem 00156 * 00157 WRITE( IOUNIT, FMT = 9939 )1 00158 ELSE IF( ITYPE.EQ.5 ) THEN 00159 * 00160 * GSVD 00161 * 00162 WRITE( IOUNIT, FMT = 9940 )1 00163 WRITE( IOUNIT, FMT = 9941 )2 00164 WRITE( IOUNIT, FMT = 9942 )3 00165 WRITE( IOUNIT, FMT = 9943 )4 00166 WRITE( IOUNIT, FMT = 9944 )5 00167 ELSE IF( ITYPE.EQ.6 ) THEN 00168 * 00169 * CSD 00170 * 00171 WRITE( IOUNIT, FMT = 9920 )1 00172 WRITE( IOUNIT, FMT = 9921 )2 00173 WRITE( IOUNIT, FMT = 9922 )3 00174 WRITE( IOUNIT, FMT = 9923 )4 00175 WRITE( IOUNIT, FMT = 9924 )5 00176 WRITE( IOUNIT, FMT = 9925 )6 00177 WRITE( IOUNIT, FMT = 9926 )7 00178 WRITE( IOUNIT, FMT = 9927 )8 00179 END IF 00180 * 00181 9999 FORMAT( 1X, A ) 00182 9991 FORMAT( / 1X, A3, ': GQR factorization of general matrices' ) 00183 9992 FORMAT( / 1X, A3, ': GRQ factorization of general matrices' ) 00184 9993 FORMAT( / 1X, A3, ': LSE Problem' ) 00185 9994 FORMAT( / 1X, A3, ': GLM Problem' ) 00186 9995 FORMAT( / 1X, A3, ': Generalized Singular Value Decomposition' ) 00187 9996 FORMAT( / 1X, A3, ': CS Decomposition' ) 00188 * 00189 9950 FORMAT( 3X, I2, ': A-diagonal matrix B-upper triangular' ) 00190 9951 FORMAT( 3X, I2, ': A-diagonal matrix B-lower triangular' ) 00191 9952 FORMAT( 3X, I2, ': A-upper triangular B-upper triangular' ) 00192 9953 FORMAT( 3X, I2, ': A-lower triangular B-diagonal triangular' ) 00193 9954 FORMAT( 3X, I2, ': A-lower triangular B-upper triangular' ) 00194 * 00195 9955 FORMAT( 3X, I2, ': Random matrices cond(A)=100, cond(B)=10,' ) 00196 * 00197 9956 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ', 00198 $ 'cond(B)= sqrt( 0.1/EPS )' ) 00199 9957 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ', 00200 $ 'cond(B)= 0.1/EPS' ) 00201 9959 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ', 00202 $ 'cond(B)= 0.1/EPS ' ) 00203 9960 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ', 00204 $ 'cond(B)= sqrt( 0.1/EPS )' ) 00205 * 00206 9961 FORMAT( 3X, I2, ': Matrix scaled near underflow limit' ) 00207 9962 FORMAT( 3X, I2, ': Matrix scaled near overflow limit' ) 00208 9963 FORMAT( 3X, I2, ': Random orthogonal matrix (Haar measure)' ) 00209 9964 FORMAT( 3X, I2, ': Nearly orthogonal matrix with uniformly ', 00210 $ 'distributed angles atan2( S, C ) in CS decomposition' ) 00211 9965 FORMAT( 3X, I2, ': Random orthogonal matrix with clustered ', 00212 $ 'angles atan2( S, C ) in CS decomposition' ) 00213 * 00214 * 00215 * GQR test ratio 00216 * 00217 9930 FORMAT( 3X, I2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )', 00218 $ '* EPS )' ) 00219 9931 FORMAT( 3X, I2, ': norm( T * Z - Q'' * B ) / ( min(P,N)*norm(B)', 00220 $ '* EPS )' ) 00221 9932 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( N * EPS )' ) 00222 9933 FORMAT( 3X, I2, ': norm( I - Z''*Z ) / ( P * EPS )' ) 00223 * 00224 * GRQ test ratio 00225 * 00226 9934 FORMAT( 3X, I2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ', 00227 $ 'EPS )' ) 00228 9935 FORMAT( 3X, I2, ': norm( T * Q - Z'' * B ) / ( min( P,N ) * nor', 00229 $ 'm(B)*EPS )' ) 00230 * 00231 * LSE test ratio 00232 * 00233 9937 FORMAT( 3X, I2, ': norm( A*x - c ) / ( norm(A)*norm(x) * EPS )' ) 00234 9938 FORMAT( 3X, I2, ': norm( B*x - d ) / ( norm(B)*norm(x) * EPS )' ) 00235 * 00236 * GLM test ratio 00237 * 00238 9939 FORMAT( 3X, I2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*', 00239 $ '(norm(x)+norm(y))*EPS )' ) 00240 * 00241 * GSVD test ratio 00242 * 00243 9940 FORMAT( 3X, I2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*', 00244 $ 'norm( A ) * EPS )' ) 00245 9941 FORMAT( 3X, I2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*', 00246 $ 'norm( B ) * EPS )' ) 00247 9942 FORMAT( 3X, I2, ': norm( I - U''*U ) / ( M * EPS )' ) 00248 9943 FORMAT( 3X, I2, ': norm( I - V''*V ) / ( P * EPS )' ) 00249 9944 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( N * EPS )' ) 00250 * 00251 * CSD test ratio 00252 * 00253 9920 FORMAT( 3X, I2, ': norm( U1'' * X11 * V1 - C ) / ( max( P, Q)', 00254 $ ' * max(norm(I-X''*X),EPS) )' ) 00255 9921 FORMAT( 3X, I2, ': norm( U1'' * X12 * V2-(-S)) / ( max( P,', 00256 $ 'M-Q) * max(norm(I-X''*X),EPS) )' ) 00257 9922 FORMAT( 3X, I2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,', 00258 $ ' Q) * max(norm(I-X''*X),EPS) )' ) 00259 9923 FORMAT( 3X, I2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,', 00260 $ 'M-Q) * max(norm(I-X''*X),EPS) )' ) 00261 9924 FORMAT( 3X, I2, ': norm( I - U1''*U1 ) / ( P * EPS )' ) 00262 9925 FORMAT( 3X, I2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' ) 00263 9926 FORMAT( 3X, I2, ': norm( I - V1''*V1 ) / ( Q * EPS )' ) 00264 9927 FORMAT( 3X, I2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' ) 00265 RETURN 00266 * 00267 * End of ALAHDG 00268 * 00269 END
1.7.3 
