LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
alahdg.f
Go to the documentation of this file.
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
 All Files Functions