LAPACK: TESTING/EIG/alahdg.f Source 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 *
00033 *  =====================================================================
00034 *
00035 *     .. Local Scalars ..
00036       CHARACTER*3       C2
00037       INTEGER           ITYPE
00038 *     ..
00039 *     .. External Functions ..
00040       LOGICAL           LSAMEN
00041       EXTERNAL          LSAMEN
00042 *     ..
00043 *     .. Executable Statements ..
00044 *
00045       IF( IOUNIT.LE.0 )
00046      $   RETURN
00047       C2 = PATH( 1: 3 )
00048 *
00049 *     First line describing matrices in this path
00050 *
00051       IF( LSAMEN( 3, C2, 'GQR' ) ) THEN
00052          ITYPE = 1
00053          WRITE( IOUNIT, FMT = 9991 )PATH
00054       ELSE IF( LSAMEN( 3, C2, 'GRQ' ) ) THEN
00055          ITYPE = 2
00056          WRITE( IOUNIT, FMT = 9992 )PATH
00057       ELSE IF( LSAMEN( 3, C2, 'LSE' ) ) THEN
00058          ITYPE = 3
00059          WRITE( IOUNIT, FMT = 9993 )PATH
00060       ELSE IF( LSAMEN( 3, C2, 'GLM' ) ) THEN
00061          ITYPE = 4
00062          WRITE( IOUNIT, FMT = 9994 )PATH
00063       ELSE IF( LSAMEN( 3, C2, 'GSV' ) ) THEN
00064          ITYPE = 5
00065          WRITE( IOUNIT, FMT = 9995 )PATH
00066       END IF
00067 *
00068 *     Matrix types
00069 *
00070       WRITE( IOUNIT, FMT = 9999 )'Matrix types: '
00071 *
00072       IF( ITYPE.EQ.1 )THEN
00073          WRITE( IOUNIT, FMT = 9950 )1
00074          WRITE( IOUNIT, FMT = 9952 )2
00075          WRITE( IOUNIT, FMT = 9954 )3
00076          WRITE( IOUNIT, FMT = 9955 )4
00077          WRITE( IOUNIT, FMT = 9956 )5
00078          WRITE( IOUNIT, FMT = 9957 )6
00079          WRITE( IOUNIT, FMT = 9961 )7
00080          WRITE( IOUNIT, FMT = 9962 )8
00081       ELSE IF( ITYPE.EQ.2 )THEN
00082          WRITE( IOUNIT, FMT = 9951 )1
00083          WRITE( IOUNIT, FMT = 9953 )2
00084          WRITE( IOUNIT, FMT = 9954 )3
00085          WRITE( IOUNIT, FMT = 9955 )4
00086          WRITE( IOUNIT, FMT = 9956 )5
00087          WRITE( IOUNIT, FMT = 9957 )6
00088          WRITE( IOUNIT, FMT = 9961 )7
00089          WRITE( IOUNIT, FMT = 9962 )8
00090       ELSE IF( ITYPE.EQ.3 )THEN
00091          WRITE( IOUNIT, FMT = 9950 )1
00092          WRITE( IOUNIT, FMT = 9952 )2
00093          WRITE( IOUNIT, FMT = 9954 )3
00094          WRITE( IOUNIT, FMT = 9955 )4
00095          WRITE( IOUNIT, FMT = 9955 )5
00096          WRITE( IOUNIT, FMT = 9955 )6
00097          WRITE( IOUNIT, FMT = 9955 )7
00098          WRITE( IOUNIT, FMT = 9955 )8
00099       ELSE IF( ITYPE.EQ.4 )THEN
00100          WRITE( IOUNIT, FMT = 9951 )1
00101          WRITE( IOUNIT, FMT = 9953 )2
00102          WRITE( IOUNIT, FMT = 9954 )3
00103          WRITE( IOUNIT, FMT = 9955 )4
00104          WRITE( IOUNIT, FMT = 9955 )5
00105          WRITE( IOUNIT, FMT = 9955 )6
00106          WRITE( IOUNIT, FMT = 9955 )7
00107          WRITE( IOUNIT, FMT = 9955 )8
00108       ELSE IF( ITYPE.EQ.5 )THEN
00109          WRITE( IOUNIT, FMT = 9950 )1
00110          WRITE( IOUNIT, FMT = 9952 )2
00111          WRITE( IOUNIT, FMT = 9954 )3
00112          WRITE( IOUNIT, FMT = 9955 )4
00113          WRITE( IOUNIT, FMT = 9956 )5
00114          WRITE( IOUNIT, FMT = 9957 )6
00115          WRITE( IOUNIT, FMT = 9959 )7
00116          WRITE( IOUNIT, FMT = 9960 )8
00117       END IF
00118 *
00119 *     Tests performed
00120 *
00121       WRITE( IOUNIT, FMT = 9999 )'Test ratios: '
00122 *
00123       IF( ITYPE.EQ.1 ) THEN
00124 *
00125 *        GQR decomposition of rectangular matrices
00126 *
00127          WRITE( IOUNIT, FMT = 9930 )1
00128          WRITE( IOUNIT, FMT = 9931 )2
00129          WRITE( IOUNIT, FMT = 9932 )3
00130          WRITE( IOUNIT, FMT = 9933 )4
00131       ELSE IF( ITYPE.EQ.2 ) THEN
00132 *
00133 *        GRQ decomposition of rectangular matrices
00134 *
00135          WRITE( IOUNIT, FMT = 9934 )1
00136          WRITE( IOUNIT, FMT = 9935 )2
00137          WRITE( IOUNIT, FMT = 9932 )3
00138          WRITE( IOUNIT, FMT = 9933 )4
00139       ELSE IF( ITYPE.EQ.3 ) THEN
00140 *
00141 *        LSE Problem
00142 *
00143          WRITE( IOUNIT, FMT = 9937 )1
00144          WRITE( IOUNIT, FMT = 9938 )2
00145       ELSE IF( ITYPE.EQ.4 ) THEN
00146 *
00147 *        GLM Problem
00148 *
00149          WRITE( IOUNIT, FMT = 9939 )1
00150       ELSE IF( ITYPE.EQ.5 ) THEN
00151 *
00152 *        GSVD
00153 *
00154          WRITE( IOUNIT, FMT = 9940 )1
00155          WRITE( IOUNIT, FMT = 9941 )2
00156          WRITE( IOUNIT, FMT = 9942 )3
00157          WRITE( IOUNIT, FMT = 9943 )4
00158          WRITE( IOUNIT, FMT = 9944 )5
00159       END IF
00160 *
00161  9999 FORMAT( 1X, A )
00162  9991 FORMAT( / 1X, A3, ': GQR factorization of general matrices' )
00163  9992 FORMAT( / 1X, A3, ': GRQ factorization of general matrices' )
00164  9993 FORMAT( / 1X, A3, ': LSE Problem' )
00165  9994 FORMAT( / 1X, A3, ': GLM Problem' )
00166  9995 FORMAT( / 1X, A3, ': Generalized Singular Value Decomposition' )
00167 *
00168  9950 FORMAT( 3X, I2, ': A-diagonal matrix  B-upper triangular' )
00169  9951 FORMAT( 3X, I2, ': A-diagonal matrix  B-lower triangular' )
00170  9952 FORMAT( 3X, I2, ': A-upper triangular B-upper triangular' )
00171  9953 FORMAT( 3X, I2, ': A-lower triangular B-diagonal triangular' )
00172  9954 FORMAT( 3X, I2, ': A-lower triangular B-upper triangular' )
00173 *
00174  9955 FORMAT( 3X, I2, ': Random matrices cond(A)=100, cond(B)=10,' )
00175 *
00176  9956 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
00177      $      'cond(B)= sqrt( 0.1/EPS )' )
00178  9957 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ',
00179      $      'cond(B)= 0.1/EPS' )
00180  9959 FORMAT( 3X, I2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
00181      $      'cond(B)=  0.1/EPS ' )
00182  9960 FORMAT( 3X, I2, ': Random matrices cond(A)= 0.1/EPS ',
00183      $      'cond(B)=  sqrt( 0.1/EPS )' )
00184 *
00185  9961 FORMAT( 3X, I2, ': Matrix scaled near underflow limit' )
00186  9962 FORMAT( 3X, I2, ': Matrix scaled near overflow limit' )
00187 *
00188 *
00189 *     GQR test ratio
00190 *
00191  9930 FORMAT( 3X, I2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )',
00192      $       '* EPS )' )
00193  9931 FORMAT( 3X, I2, ': norm( T * Z - Q'' * B )  / ( min(P,N)*norm(B)',
00194      $       '* EPS )' )
00195  9932 FORMAT( 3X, I2, ': norm( I - Q''*Q )   / ( N * EPS )' )
00196  9933 FORMAT( 3X, I2, ': norm( I - Z''*Z )   / ( P * EPS )' )
00197 *
00198 *     GRQ test ratio
00199 *
00200  9934 FORMAT( 3X, I2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ',
00201      $       'EPS )' )
00202  9935 FORMAT( 3X, I2, ': norm( T * Q - Z'' * B )  / ( min( P,N ) * nor',
00203      $       'm(B)*EPS )' )
00204 *
00205 *     LSE test ratio
00206 *
00207  9937 FORMAT( 3X, I2, ': norm( A*x - c )  / ( norm(A)*norm(x) * EPS )' )
00208  9938 FORMAT( 3X, I2, ': norm( B*x - d )  / ( norm(B)*norm(x) * EPS )' )
00209 *
00210 *     GLM test ratio
00211 *
00212  9939 FORMAT( 3X, I2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*',
00213      $       '(norm(x)+norm(y))*EPS )' )
00214 *
00215 *     GSVD test ratio
00216 *
00217  9940 FORMAT( 3X, I2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*',
00218      $       'norm( A ) * EPS )' )
00219  9941 FORMAT( 3X, I2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*',
00220      $       'norm( B ) * EPS )' )
00221  9942 FORMAT( 3X, I2, ': norm( I - U''*U )   / ( M * EPS )' )
00222  9943 FORMAT( 3X, I2, ': norm( I - V''*V )   / ( P * EPS )' )
00223  9944 FORMAT( 3X, I2, ': norm( I - Q''*Q )   / ( N * EPS )' )
00224       RETURN
00225 *
00226 *     End of ALAHDG
00227 *
00228       END