LAPACK: TESTING/EIG/alahdg.f Source File

Go to the documentation of this file.
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