alahdg.f

Go to the documentation of this file.

*> \brief \b ALAHDG
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at 
*            http://www.netlib.org/lapack/explore-html/ 
*
*  Definition:
*  ===========
*
*       SUBROUTINE ALAHDG( IOUNIT, PATH )
* 
*       .. Scalar Arguments ..
*       CHARACTER*3       PATH
*       INTEGER           IOUNIT
*       ..
*  
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> ALAHDG prints header information for the different test paths.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] IOUNIT
*> \verbatim
*>          IOUNIT is INTEGER
*>          The unit number to which the header information should be
*>          printed.
*> \endverbatim
*>
*> \param[in] PATH
*> \verbatim
*>          PATH is CHARACTER*3
*>          The name of the path for which the header information is to
*>          be printed.  Current paths are
*>             GQR:  GQR (general matrices)
*>             GRQ:  GRQ (general matrices)
*>             LSE:  LSE Problem
*>             GLM:  GLM Problem
*>             GSV:  Generalized Singular Value Decomposition
*>             CSD:  CS Decomposition
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee 
*> \author Univ. of California Berkeley 
*> \author Univ. of Colorado Denver 
*> \author NAG Ltd. 
*
*> \date November 2011
*
*> \ingroup aux_eig
*
*  =====================================================================
      SUBROUTINE alahdg( IOUNIT, PATH )
*
*  -- LAPACK test routine (version 3.4.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     November 2011
*
*     .. Scalar Arguments ..
      CHARACTER*3       path
      INTEGER           iounit
*     ..
*
*  =====================================================================
*
*     .. Local Scalars ..
      CHARACTER*3       c2
      INTEGER           itype
*     ..
*     .. External Functions ..
      LOGICAL           lsamen
      EXTERNAL          lsamen
*     ..
*     .. Executable Statements ..
*
      IF( iounit.LE.0 )
     $   return
      c2 = path( 1: 3 )
*
*     First line describing matrices in this path
*
      IF( lsamen( 3, c2, 'GQR' ) ) THEN
         itype = 1
         WRITE( iounit, fmt = 9991 )path
      ELSE IF( lsamen( 3, c2, 'GRQ' ) ) THEN
         itype = 2
         WRITE( iounit, fmt = 9992 )path
      ELSE IF( lsamen( 3, c2, 'LSE' ) ) THEN
         itype = 3
         WRITE( iounit, fmt = 9993 )path
      ELSE IF( lsamen( 3, c2, 'GLM' ) ) THEN
         itype = 4
         WRITE( iounit, fmt = 9994 )path
      ELSE IF( lsamen( 3, c2, 'GSV' ) ) THEN
         itype = 5
         WRITE( iounit, fmt = 9995 )path
      ELSE IF( lsamen( 3, c2, 'CSD' ) ) THEN
         itype = 6
         WRITE( iounit, fmt = 9996 )path
      END IF
*
*     Matrix types
*
      WRITE( iounit, fmt = 9999 )'Matrix types: '
*
      IF( itype.EQ.1 )THEN
         WRITE( iounit, fmt = 9950 )1
         WRITE( iounit, fmt = 9952 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9956 )5
         WRITE( iounit, fmt = 9957 )6
         WRITE( iounit, fmt = 9961 )7
         WRITE( iounit, fmt = 9962 )8
      ELSE IF( itype.EQ.2 )THEN
         WRITE( iounit, fmt = 9951 )1
         WRITE( iounit, fmt = 9953 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9956 )5
         WRITE( iounit, fmt = 9957 )6
         WRITE( iounit, fmt = 9961 )7
         WRITE( iounit, fmt = 9962 )8
      ELSE IF( itype.EQ.3 )THEN
         WRITE( iounit, fmt = 9950 )1
         WRITE( iounit, fmt = 9952 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9955 )5
         WRITE( iounit, fmt = 9955 )6
         WRITE( iounit, fmt = 9955 )7
         WRITE( iounit, fmt = 9955 )8
      ELSE IF( itype.EQ.4 )THEN
         WRITE( iounit, fmt = 9951 )1
         WRITE( iounit, fmt = 9953 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9955 )5
         WRITE( iounit, fmt = 9955 )6
         WRITE( iounit, fmt = 9955 )7
         WRITE( iounit, fmt = 9955 )8
      ELSE IF( itype.EQ.5 )THEN
         WRITE( iounit, fmt = 9950 )1
         WRITE( iounit, fmt = 9952 )2
         WRITE( iounit, fmt = 9954 )3
         WRITE( iounit, fmt = 9955 )4
         WRITE( iounit, fmt = 9956 )5
         WRITE( iounit, fmt = 9957 )6
         WRITE( iounit, fmt = 9959 )7
         WRITE( iounit, fmt = 9960 )8
      ELSE IF( itype.EQ.6 )THEN
         WRITE( iounit, fmt = 9963 )1
         WRITE( iounit, fmt = 9964 )2
         WRITE( iounit, fmt = 9965 )3
      END IF
*
*     Tests performed
*
      WRITE( iounit, fmt = 9999 )'Test ratios: '
*
      IF( itype.EQ.1 ) THEN
*
*        GQR decomposition of rectangular matrices
*
         WRITE( iounit, fmt = 9930 )1
         WRITE( iounit, fmt = 9931 )2
         WRITE( iounit, fmt = 9932 )3
         WRITE( iounit, fmt = 9933 )4
      ELSE IF( itype.EQ.2 ) THEN
*
*        GRQ decomposition of rectangular matrices
*
         WRITE( iounit, fmt = 9934 )1
         WRITE( iounit, fmt = 9935 )2
         WRITE( iounit, fmt = 9932 )3
         WRITE( iounit, fmt = 9933 )4
      ELSE IF( itype.EQ.3 ) THEN
*
*        LSE Problem
*
         WRITE( iounit, fmt = 9937 )1
         WRITE( iounit, fmt = 9938 )2
      ELSE IF( itype.EQ.4 ) THEN
*
*        GLM Problem
*
         WRITE( iounit, fmt = 9939 )1
      ELSE IF( itype.EQ.5 ) THEN
*
*        GSVD
*
         WRITE( iounit, fmt = 9940 )1
         WRITE( iounit, fmt = 9941 )2
         WRITE( iounit, fmt = 9942 )3
         WRITE( iounit, fmt = 9943 )4
         WRITE( iounit, fmt = 9944 )5
      ELSE IF( itype.EQ.6 ) THEN
*
*        CSD
*
         WRITE( iounit, fmt = 9920 )1
         WRITE( iounit, fmt = 9921 )2
         WRITE( iounit, fmt = 9922 )3
         WRITE( iounit, fmt = 9923 )4
         WRITE( iounit, fmt = 9924 )5
         WRITE( iounit, fmt = 9925 )6
         WRITE( iounit, fmt = 9926 )7
         WRITE( iounit, fmt = 9927 )8
      END IF
*
 9999 format( 1x, a )
 9991 format( / 1x, a3, ': GQR factorization of general matrices' )
 9992 format( / 1x, a3, ': GRQ factorization of general matrices' )
 9993 format( / 1x, a3, ': LSE Problem' )
 9994 format( / 1x, a3, ': GLM Problem' )
 9995 format( / 1x, a3, ': Generalized Singular Value Decomposition' )
 9996 format( / 1x, a3, ': CS Decomposition' )
*
 9950 format( 3x, i2, ': A-diagonal matrix  B-upper triangular' )
 9951 format( 3x, i2, ': A-diagonal matrix  B-lower triangular' )
 9952 format( 3x, i2, ': A-upper triangular B-upper triangular' )
 9953 format( 3x, i2, ': A-lower triangular B-diagonal triangular' )
 9954 format( 3x, i2, ': A-lower triangular B-upper triangular' )
*
 9955 format( 3x, i2, ': Random matrices cond(A)=100, cond(B)=10,' )
*
 9956 format( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
     $      'cond(B)= sqrt( 0.1/EPS )' )
 9957 format( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
     $      'cond(B)= 0.1/EPS' )
 9959 format( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
     $      'cond(B)=  0.1/EPS ' )
 9960 format( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
     $      'cond(B)=  sqrt( 0.1/EPS )' )
*
 9961 format( 3x, i2, ': Matrix scaled near underflow limit' )
 9962 format( 3x, i2, ': Matrix scaled near overflow limit' )
 9963 format( 3x, i2, ': Random orthogonal matrix (Haar measure)' )
 9964 format( 3x, i2, ': Nearly orthogonal matrix with uniformly ',
     $      'distributed angles atan2( S, C ) in CS decomposition' )
 9965 format( 3x, i2, ': Random orthogonal matrix with clustered ',
     $      'angles atan2( S, C ) in CS decomposition' )
*
*
*     GQR test ratio
*
 9930 format( 3x, i2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )',
     $       '* EPS )' )
 9931 format( 3x, i2, ': norm( T * Z - Q'' * B )  / ( min(P,N)*norm(B)',
     $       '* EPS )' )
 9932 format( 3x, i2, ': norm( I - Q''*Q )   / ( N * EPS )' )
 9933 format( 3x, i2, ': norm( I - Z''*Z )   / ( P * EPS )' )
*
*     GRQ test ratio
*
 9934 format( 3x, i2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ',
     $       'EPS )' )
 9935 format( 3x, i2, ': norm( T * Q - Z'' * B )  / ( min( P,N ) * nor',
     $       'm(B)*EPS )' )
*
*     LSE test ratio
*
 9937 format( 3x, i2, ': norm( A*x - c )  / ( norm(A)*norm(x) * EPS )' )
 9938 format( 3x, i2, ': norm( B*x - d )  / ( norm(B)*norm(x) * EPS )' )
*
*     GLM test ratio
*
 9939 format( 3x, i2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*',
     $       '(norm(x)+norm(y))*EPS )' )
*
*     GSVD test ratio
*
 9940 format( 3x, i2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*',
     $       'norm( A ) * EPS )' )
 9941 format( 3x, i2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*',
     $       'norm( B ) * EPS )' )
 9942 format( 3x, i2, ': norm( I - U''*U )   / ( M * EPS )' )
 9943 format( 3x, i2, ': norm( I - V''*V )   / ( P * EPS )' )
 9944 format( 3x, i2, ': norm( I - Q''*Q )   / ( N * EPS )' )
*
*     CSD test ratio
*
 9920 format( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max(  P,  Q)',
     $       ' * max(norm(I-X''*X),EPS) )' )
 9921 format( 3x, i2, ': norm( U1'' * X12 * V2-(-S)) / ( max(  P,',
     $       'M-Q) * max(norm(I-X''*X),EPS) )' )
 9922 format( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,',
     $       '  Q) * max(norm(I-X''*X),EPS) )' )
 9923 format( 3x, i2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,',
     $       'M-Q) * max(norm(I-X''*X),EPS) )' )
 9924 format( 3x, i2, ': norm( I - U1''*U1 ) / (   P   * EPS )' )
 9925 format( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
 9926 format( 3x, i2, ': norm( I - V1''*V1 ) / (   Q   * EPS )' )
 9927 format( 3x, i2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' )
      return
*
*     End of ALAHDG
*
      END