![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ALAHDG 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 ALAHDG( IOUNIT, PATH ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER IOUNIT 00016 * .. 00017 * 00018 * 00019 *> \par Purpose: 00020 * ============= 00021 *> 00022 *> \verbatim 00023 *> 00024 *> ALAHDG prints header information for the different test paths. 00025 *> \endverbatim 00026 * 00027 * Arguments: 00028 * ========== 00029 * 00030 *> \param[in] IOUNIT 00031 *> \verbatim 00032 *> IOUNIT is INTEGER 00033 *> The unit number to which the header information should be 00034 *> printed. 00035 *> \endverbatim 00036 *> 00037 *> \param[in] PATH 00038 *> \verbatim 00039 *> PATH is CHARACTER*3 00040 *> The name of the path for which the header information is to 00041 *> be printed. Current paths are 00042 *> GQR: GQR (general matrices) 00043 *> GRQ: GRQ (general matrices) 00044 *> LSE: LSE Problem 00045 *> GLM: GLM Problem 00046 *> GSV: Generalized Singular Value Decomposition 00047 *> CSD: CS Decomposition 00048 *> \endverbatim 00049 * 00050 * Authors: 00051 * ======== 00052 * 00053 *> \author Univ. of Tennessee 00054 *> \author Univ. of California Berkeley 00055 *> \author Univ. of Colorado Denver 00056 *> \author NAG Ltd. 00057 * 00058 *> \date November 2011 00059 * 00060 *> \ingroup aux_eig 00061 * 00062 * ===================================================================== 00063 SUBROUTINE ALAHDG( IOUNIT, PATH ) 00064 * 00065 * -- LAPACK test routine (version 3.4.0) -- 00066 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00067 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00068 * November 2011 00069 * 00070 * .. Scalar Arguments .. 00071 CHARACTER*3 PATH 00072 INTEGER IOUNIT 00073 * .. 00074 * 00075 * ===================================================================== 00076 * 00077 * .. Local Scalars .. 00078 CHARACTER*3 C2 00079 INTEGER ITYPE 00080 * .. 00081 * .. External Functions .. 00082 LOGICAL LSAMEN 00083 EXTERNAL LSAMEN 00084 * .. 00085 * .. Executable Statements .. 00086 * 00087 IF( IOUNIT.LE.0 ) 00088 $ RETURN 00089 C2 = PATH( 1: 3 ) 00090 * 00091 * First line describing matrices in this path 00092 * 00093 IF( LSAMEN( 3, C2, 'GQR' ) ) THEN 00094 ITYPE = 1 00095 WRITE( IOUNIT, FMT = 9991 )PATH 00096 ELSE IF( LSAMEN( 3, C2, 'GRQ' ) ) THEN 00097 ITYPE = 2 00098 WRITE( IOUNIT, FMT = 9992 )PATH 00099 ELSE IF( LSAMEN( 3, C2, 'LSE' ) ) THEN 00100 ITYPE = 3 00101 WRITE( IOUNIT, FMT = 9993 )PATH 00102 ELSE IF( LSAMEN( 3, C2, 'GLM' ) ) THEN 00103 ITYPE = 4 00104 WRITE( IOUNIT, FMT = 9994 )PATH 00105 ELSE IF( LSAMEN( 3, C2, 'GSV' ) ) THEN 00106 ITYPE = 5 00107 WRITE( IOUNIT, FMT = 9995 )PATH 00108 ELSE IF( LSAMEN( 3, C2, 'CSD' ) ) THEN 00109 ITYPE = 6 00110 WRITE( IOUNIT, FMT = 9996 )PATH 00111 END IF 00112 * 00113 * Matrix types 00114 * 00115 WRITE( IOUNIT, FMT = 9999 )'Matrix types: ' 00116 * 00117 IF( ITYPE.EQ.1 )THEN 00118 WRITE( IOUNIT, FMT = 9950 )1 00119 WRITE( IOUNIT, FMT = 9952 )2 00120 WRITE( IOUNIT, FMT = 9954 )3 00121 WRITE( IOUNIT, FMT = 9955 )4 00122 WRITE( IOUNIT, FMT = 9956 )5 00123 WRITE( IOUNIT, FMT = 9957 )6 00124 WRITE( IOUNIT, FMT = 9961 )7 00125 WRITE( IOUNIT, FMT = 9962 )8 00126 ELSE IF( ITYPE.EQ.2 )THEN 00127 WRITE( IOUNIT, FMT = 9951 )1 00128 WRITE( IOUNIT, FMT = 9953 )2 00129 WRITE( IOUNIT, FMT = 9954 )3 00130 WRITE( IOUNIT, FMT = 9955 )4 00131 WRITE( IOUNIT, FMT = 9956 )5 00132 WRITE( IOUNIT, FMT = 9957 )6 00133 WRITE( IOUNIT, FMT = 9961 )7 00134 WRITE( IOUNIT, FMT = 9962 )8 00135 ELSE IF( ITYPE.EQ.3 )THEN 00136 WRITE( IOUNIT, FMT = 9950 )1 00137 WRITE( IOUNIT, FMT = 9952 )2 00138 WRITE( IOUNIT, FMT = 9954 )3 00139 WRITE( IOUNIT, FMT = 9955 )4 00140 WRITE( IOUNIT, FMT = 9955 )5 00141 WRITE( IOUNIT, FMT = 9955 )6 00142 WRITE( IOUNIT, FMT = 9955 )7 00143 WRITE( IOUNIT, FMT = 9955 )8 00144 ELSE IF( ITYPE.EQ.4 )THEN 00145 WRITE( IOUNIT, FMT = 9951 )1 00146 WRITE( IOUNIT, FMT = 9953 )2 00147 WRITE( IOUNIT, FMT = 9954 )3 00148 WRITE( IOUNIT, FMT = 9955 )4 00149 WRITE( IOUNIT, FMT = 9955 )5 00150 WRITE( IOUNIT, FMT = 9955 )6 00151 WRITE( IOUNIT, FMT = 9955 )7 00152 WRITE( IOUNIT, FMT = 9955 )8 00153 ELSE IF( ITYPE.EQ.5 )THEN 00154 WRITE( IOUNIT, FMT = 9950 )1 00155 WRITE( IOUNIT, FMT = 9952 )2 00156 WRITE( IOUNIT, FMT = 9954 )3 00157 WRITE( IOUNIT, FMT = 9955 )4 00158 WRITE( IOUNIT, FMT = 9956 )5 00159 WRITE( IOUNIT, FMT = 9957 )6 00160 WRITE( IOUNIT, FMT = 9959 )7 00161 WRITE( IOUNIT, FMT = 9960 )8 00162 ELSE IF( ITYPE.EQ.6 )THEN 00163 WRITE( IOUNIT, FMT = 9963 )1 00164 WRITE( IOUNIT, FMT = 9964 )2 00165 WRITE( IOUNIT, FMT = 9965 )3 00166 END IF 00167 * 00168 * Tests performed 00169 * 00170 WRITE( IOUNIT, FMT = 9999 )'Test ratios: ' 00171 * 00172 IF( ITYPE.EQ.1 ) THEN 00173 * 00174 * GQR decomposition of rectangular matrices 00175 * 00176 WRITE( IOUNIT, FMT = 9930 )1 00177 WRITE( IOUNIT, FMT = 9931 )2 00178 WRITE( IOUNIT, FMT = 9932 )3 00179 WRITE( IOUNIT, FMT = 9933 )4 00180 ELSE IF( ITYPE.EQ.2 ) THEN 00181 * 00182 * GRQ decomposition of rectangular matrices 00183 * 00184 WRITE( IOUNIT, FMT = 9934 )1 00185 WRITE( IOUNIT, FMT = 9935 )2 00186 WRITE( IOUNIT, FMT = 9932 )3 00187 WRITE( IOUNIT, FMT = 9933 )4 00188 ELSE IF( ITYPE.EQ.3 ) THEN 00189 * 00190 * LSE Problem 00191 * 00192 WRITE( IOUNIT, FMT = 9937 )1 00193 WRITE( IOUNIT, FMT = 9938 )2 00194 ELSE IF( ITYPE.EQ.4 ) THEN 00195 * 00196 * GLM Problem 00197 * 00198 WRITE( IOUNIT, FMT = 9939 )1 00199 ELSE IF( ITYPE.EQ.5 ) THEN 00200 * 00201 * GSVD 00202 * 00203 WRITE( IOUNIT, FMT = 9940 )1 00204 WRITE( IOUNIT, FMT = 9941 )2 00205 WRITE( IOUNIT, FMT = 9942 )3 00206 WRITE( IOUNIT, FMT = 9943 )4 00207 WRITE( IOUNIT, FMT = 9944 )5 00208 ELSE IF( ITYPE.EQ.6 ) THEN 00209 * 00210 * CSD 00211 * 00212 WRITE( IOUNIT, FMT = 9920 )1 00213 WRITE( IOUNIT, FMT = 9921 )2 00214 WRITE( IOUNIT, FMT = 9922 )3 00215 WRITE( IOUNIT, FMT = 9923 )4 00216 WRITE( IOUNIT, FMT = 9924 )5 00217 WRITE( IOUNIT, FMT = 9925 )6 00218 WRITE( IOUNIT, FMT = 9926 )7 00219 WRITE( IOUNIT, FMT = 9927 )8 00220 END IF 00221 * 00222 9999 FORMAT( 1X, A ) 00223 9991 FORMAT( / 1X, A3, ': GQR factorization of general matrices' ) 00224 9992 FORMAT( / 1X, A3, ': GRQ factorization of general matrices' ) 00225 9993 FORMAT( / 1X, A3, ': LSE Problem' ) 00226 9994 FORMAT( / 1X, A3, ': GLM Problem' ) 00227 9995 FORMAT( / 1X, A3, ': Generalized Singular Value Decomposition' ) 00228 9996 FORMAT( / 1X, A3, ': CS Decomposition' ) 00229 * 00230 9950 FORMAT( 3X, I2, ': A-diagonal matrix B-upper triangular' ) 00231 9951 FORMAT( 3X, I2, ': A-diagonal matrix B-lower triangular' ) 00232 9952 FORMAT( 3X, I2, ': A-upper triangular B-upper triangular' ) 00233 9953 FORMAT( 3X, I2, ': A-lower triangular B-diagonal triangular' ) 00234 9954 FORMAT( 3X, I2, ': A-lower triangular B-upper triangular' ) 00235 * 00236 9955 FORMAT( 3X, I2, ': Random matrices cond(A)=100, cond(B)=10,' ) 00237 * 00238 9956 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ', 00239 $ 'cond(B)= sqrt( 0.1/EPS )' ) 00240 9957 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ', 00241 $ 'cond(B)= 0.1/EPS' ) 00242 9959 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ', 00243 $ 'cond(B)= 0.1/EPS ' ) 00244 9960 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ', 00245 $ 'cond(B)= sqrt( 0.1/EPS )' ) 00246 * 00247 9961 FORMAT( 3X, I2, ': Matrix scaled near underflow limit' ) 00248 9962 FORMAT( 3X, I2, ': Matrix scaled near overflow limit' ) 00249 9963 FORMAT( 3X, I2, ': Random orthogonal matrix (Haar measure)' ) 00250 9964 FORMAT( 3X, I2, ': Nearly orthogonal matrix with uniformly ', 00251 $ 'distributed angles atan2( S, C ) in CS decomposition' ) 00252 9965 FORMAT( 3X, I2, ': Random orthogonal matrix with clustered ', 00253 $ 'angles atan2( S, C ) in CS decomposition' ) 00254 * 00255 * 00256 * GQR test ratio 00257 * 00258 9930 FORMAT( 3X, I2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )', 00259 $ '* EPS )' ) 00260 9931 FORMAT( 3X, I2, ': norm( T * Z - Q'' * B ) / ( min(P,N)*norm(B)', 00261 $ '* EPS )' ) 00262 9932 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( N * EPS )' ) 00263 9933 FORMAT( 3X, I2, ': norm( I - Z''*Z ) / ( P * EPS )' ) 00264 * 00265 * GRQ test ratio 00266 * 00267 9934 FORMAT( 3X, I2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ', 00268 $ 'EPS )' ) 00269 9935 FORMAT( 3X, I2, ': norm( T * Q - Z'' * B ) / ( min( P,N ) * nor', 00270 $ 'm(B)*EPS )' ) 00271 * 00272 * LSE test ratio 00273 * 00274 9937 FORMAT( 3X, I2, ': norm( A*x - c ) / ( norm(A)*norm(x) * EPS )' ) 00275 9938 FORMAT( 3X, I2, ': norm( B*x - d ) / ( norm(B)*norm(x) * EPS )' ) 00276 * 00277 * GLM test ratio 00278 * 00279 9939 FORMAT( 3X, I2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*', 00280 $ '(norm(x)+norm(y))*EPS )' ) 00281 * 00282 * GSVD test ratio 00283 * 00284 9940 FORMAT( 3X, I2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*', 00285 $ 'norm( A ) * EPS )' ) 00286 9941 FORMAT( 3X, I2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*', 00287 $ 'norm( B ) * EPS )' ) 00288 9942 FORMAT( 3X, I2, ': norm( I - U''*U ) / ( M * EPS )' ) 00289 9943 FORMAT( 3X, I2, ': norm( I - V''*V ) / ( P * EPS )' ) 00290 9944 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( N * EPS )' ) 00291 * 00292 * CSD test ratio 00293 * 00294 9920 FORMAT( 3X, I2, ': norm( U1'' * X11 * V1 - C ) / ( max( P, Q)', 00295 $ ' * max(norm(I-X''*X),EPS) )' ) 00296 9921 FORMAT( 3X, I2, ': norm( U1'' * X12 * V2-(-S)) / ( max( P,', 00297 $ 'M-Q) * max(norm(I-X''*X),EPS) )' ) 00298 9922 FORMAT( 3X, I2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,', 00299 $ ' Q) * max(norm(I-X''*X),EPS) )' ) 00300 9923 FORMAT( 3X, I2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,', 00301 $ 'M-Q) * max(norm(I-X''*X),EPS) )' ) 00302 9924 FORMAT( 3X, I2, ': norm( I - U1''*U1 ) / ( P * EPS )' ) 00303 9925 FORMAT( 3X, I2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' ) 00304 9926 FORMAT( 3X, I2, ': norm( I - V1''*V1 ) / ( Q * EPS )' ) 00305 9927 FORMAT( 3X, I2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' ) 00306 RETURN 00307 * 00308 * End of ALAHDG 00309 * 00310 END