Cloned library LAPACK-3.11.0 with extra build files for internal package management.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

518 lines
18 KiB

2 years ago
*> \brief \b ALADHD
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* SUBROUTINE ALADHD( IOUNIT, PATH )
*
* .. Scalar Arguments ..
* CHARACTER*3 PATH
* INTEGER IOUNIT
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ALADHD prints header information for the driver routines 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
*> _GE: General matrices
*> _GB: General band
*> _GT: General Tridiagonal
*> _PO: Symmetric or Hermitian positive definite
*> _PS: Symmetric or Hermitian positive semi-definite
*> _PP: Symmetric or Hermitian positive definite packed
*> _PB: Symmetric or Hermitian positive definite band
*> _PT: Symmetric or Hermitian positive definite tridiagonal
*> _SY: Symmetric indefinite,
*> with partial (Bunch-Kaufman) pivoting
*> _SR: Symmetric indefinite,
*> with rook (bounded Bunch-Kaufman) pivoting
*> _SK: Symmetric indefinite,
*> with rook (bounded Bunch-Kaufman) pivoting
*> ( new storage format for factors:
*> L and diagonal of D is stored in A,
*> subdiagonal of D is stored in E )
*> _SP: Symmetric indefinite packed,
*> with partial (Bunch-Kaufman) pivoting
*> _HA: (complex) Hermitian ,
*> Assen Algorithm
*> _HE: (complex) Hermitian indefinite,
*> with partial (Bunch-Kaufman) pivoting
*> _HR: (complex) Hermitian indefinite,
*> with rook (bounded Bunch-Kaufman) pivoting
*> _HK: (complex) Hermitian indefinite,
*> with rook (bounded Bunch-Kaufman) pivoting
*> ( new storage format for factors:
*> L and diagonal of D is stored in A,
*> subdiagonal of D is stored in E )
*> _HP: (complex) Hermitian indefinite packed,
*> with partial (Bunch-Kaufman) pivoting
*> The first character must be one of S, D, C, or Z (C or Z only
*> if complex).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup aux_lin
*
* =====================================================================
SUBROUTINE ALADHD( IOUNIT, PATH )
*
* -- LAPACK test routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
* .. Scalar Arguments ..
CHARACTER*3 PATH
INTEGER IOUNIT
* ..
*
* =====================================================================
*
* .. Local Scalars ..
LOGICAL CORZ, SORD
CHARACTER C1, C3
CHARACTER*2 P2
CHARACTER*9 SYM
* ..
* .. External Functions ..
LOGICAL LSAME, LSAMEN
EXTERNAL LSAME, LSAMEN
* ..
* .. Executable Statements ..
*
IF( IOUNIT.LE.0 )
$ RETURN
C1 = PATH( 1: 1 )
C3 = PATH( 3: 3 )
P2 = PATH( 2: 3 )
SORD = LSAME( C1, 'S' ) .OR. LSAME( C1, 'D' )
CORZ = LSAME( C1, 'C' ) .OR. LSAME( C1, 'Z' )
IF( .NOT.( SORD .OR. CORZ ) )
$ RETURN
*
IF( LSAMEN( 2, P2, 'GE' ) ) THEN
*
* GE: General dense
*
WRITE( IOUNIT, FMT = 9999 )PATH
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
WRITE( IOUNIT, FMT = 9989 )
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9981 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9978 )4
WRITE( IOUNIT, FMT = 9977 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = 9972 )7
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'GB' ) ) THEN
*
* GB: General band
*
WRITE( IOUNIT, FMT = 9998 )PATH
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
WRITE( IOUNIT, FMT = 9988 )
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9981 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9978 )4
WRITE( IOUNIT, FMT = 9977 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = 9972 )7
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'GT' ) ) THEN
*
* GT: General tridiagonal
*
WRITE( IOUNIT, FMT = 9997 )PATH
WRITE( IOUNIT, FMT = 9987 )
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9981 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9978 )4
WRITE( IOUNIT, FMT = 9977 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'PO' ) .OR. LSAMEN( 2, P2, 'PP' )
$ .OR. LSAMEN( 2, P2, 'PS' ) ) THEN
*
* PO: Positive definite full
* PS: Positive definite full
* PP: Positive definite packed
*
IF( SORD ) THEN
SYM = 'Symmetric'
ELSE
SYM = 'Hermitian'
END IF
IF( LSAME( C3, 'O' ) ) THEN
WRITE( IOUNIT, FMT = 9996 )PATH, SYM
ELSE
WRITE( IOUNIT, FMT = 9995 )PATH, SYM
END IF
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
WRITE( IOUNIT, FMT = 9985 )PATH
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9975 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9978 )4
WRITE( IOUNIT, FMT = 9977 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'PB' ) ) THEN
*
* PB: Positive definite band
*
IF( SORD ) THEN
WRITE( IOUNIT, FMT = 9994 )PATH, 'Symmetric'
ELSE
WRITE( IOUNIT, FMT = 9994 )PATH, 'Hermitian'
END IF
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
WRITE( IOUNIT, FMT = 9984 )PATH
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9975 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9978 )4
WRITE( IOUNIT, FMT = 9977 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'PT' ) ) THEN
*
* PT: Positive definite tridiagonal
*
IF( SORD ) THEN
WRITE( IOUNIT, FMT = 9993 )PATH, 'Symmetric'
ELSE
WRITE( IOUNIT, FMT = 9993 )PATH, 'Hermitian'
END IF
WRITE( IOUNIT, FMT = 9986 )
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9973 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9978 )4
WRITE( IOUNIT, FMT = 9977 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'SY' ) .OR. LSAMEN( 2, P2, 'SP' ) ) THEN
*
* SY: Symmetric indefinite full
* with partial (Bunch-Kaufman) pivoting algorithm
* SP: Symmetric indefinite packed
* with partial (Bunch-Kaufman) pivoting algorithm
*
IF( LSAME( C3, 'Y' ) ) THEN
WRITE( IOUNIT, FMT = 9992 )PATH, 'Symmetric'
ELSE
WRITE( IOUNIT, FMT = 9991 )PATH, 'Symmetric'
END IF
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
IF( SORD ) THEN
WRITE( IOUNIT, FMT = 9983 )
ELSE
WRITE( IOUNIT, FMT = 9982 )
END IF
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9974 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9977 )4
WRITE( IOUNIT, FMT = 9978 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'SR' ) .OR. LSAMEN( 2, P2, 'SK') ) THEN
*
* SR: Symmetric indefinite full,
* with rook (bounded Bunch-Kaufman) pivoting algorithm
*
* SK: Symmetric indefinite full,
* with rook (bounded Bunch-Kaufman) pivoting algorithm,
* ( new storage format for factors:
* L and diagonal of D is stored in A,
* subdiagonal of D is stored in E )
*
WRITE( IOUNIT, FMT = 9992 )PATH, 'Symmetric'
*
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
IF( SORD ) THEN
WRITE( IOUNIT, FMT = 9983 )
ELSE
WRITE( IOUNIT, FMT = 9982 )
END IF
*
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9974 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'HA' ) ) THEN
*
* HA: Hermitian
* Aasen algorithm
WRITE( IOUNIT, FMT = 9971 )PATH, 'Hermitian'
*
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
WRITE( IOUNIT, FMT = 9983 )
*
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9974 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9977 )4
WRITE( IOUNIT, FMT = 9978 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR.
$ LSAMEN( 2, P2, 'HP' ) ) THEN
*
* HE: Hermitian indefinite full
* with partial (Bunch-Kaufman) pivoting algorithm
* HP: Hermitian indefinite packed
* with partial (Bunch-Kaufman) pivoting algorithm
*
IF( LSAME( C3, 'E' ) ) THEN
WRITE( IOUNIT, FMT = 9992 )PATH, 'Hermitian'
ELSE
WRITE( IOUNIT, FMT = 9991 )PATH, 'Hermitian'
END IF
*
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
WRITE( IOUNIT, FMT = 9983 )
*
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9974 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = 9977 )4
WRITE( IOUNIT, FMT = 9978 )5
WRITE( IOUNIT, FMT = 9976 )6
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE IF( LSAMEN( 2, P2, 'HR' ) .OR. LSAMEN( 2, P2, 'HK' ) ) THEN
*
* HR: Hermitian indefinite full,
* with rook (bounded Bunch-Kaufman) pivoting algorithm
*
* HK: Hermitian indefinite full,
* with rook (bounded Bunch-Kaufman) pivoting algorithm,
* ( new storage format for factors:
* L and diagonal of D is stored in A,
* subdiagonal of D is stored in E )
*
WRITE( IOUNIT, FMT = 9992 )PATH, 'Hermitian'
*
WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
WRITE( IOUNIT, FMT = 9983 )
*
WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
WRITE( IOUNIT, FMT = 9974 )1
WRITE( IOUNIT, FMT = 9980 )2
WRITE( IOUNIT, FMT = 9979 )3
WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
ELSE
*
* Print error message if no header is available.
*
WRITE( IOUNIT, FMT = 9990 )PATH
END IF
*
* First line of header
*
9999 FORMAT( / 1X, A3, ' drivers: General dense matrices' )
9998 FORMAT( / 1X, A3, ' drivers: General band matrices' )
9997 FORMAT( / 1X, A3, ' drivers: General tridiagonal' )
9996 FORMAT( / 1X, A3, ' drivers: ', A9,
$ ' positive definite matrices' )
9995 FORMAT( / 1X, A3, ' drivers: ', A9,
$ ' positive definite packed matrices' )
9994 FORMAT( / 1X, A3, ' drivers: ', A9,
$ ' positive definite band matrices' )
9993 FORMAT( / 1X, A3, ' drivers: ', A9,
$ ' positive definite tridiagonal' )
9971 FORMAT( / 1X, A3, ' drivers: ', A9, ' indefinite matrices',
$ ', "Aasen" Algorithm' )
9992 FORMAT( / 1X, A3, ' drivers: ', A9, ' indefinite matrices',
$ ', "rook" (bounded Bunch-Kaufman) pivoting' )
9991 FORMAT( / 1X, A3, ' drivers: ', A9,
$ ' indefinite packed matrices',
$ ', partial (Bunch-Kaufman) pivoting' )
9891 FORMAT( / 1X, A3, ' drivers: ', A9,
$ ' indefinite packed matrices',
$ ', "rook" (bounded Bunch-Kaufman) pivoting' )
9990 FORMAT( / 1X, A3, ': No header available' )
*
* GE matrix types
*
9989 FORMAT( 4X, '1. Diagonal', 24X, '7. Last n/2 columns zero', / 4X,
$ '2. Upper triangular', 16X,
$ '8. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
$ '3. Lower triangular', 16X, '9. Random, CNDNUM = 0.1/EPS',
$ / 4X, '4. Random, CNDNUM = 2', 13X,
$ '10. Scaled near underflow', / 4X, '5. First column zero',
$ 14X, '11. Scaled near overflow', / 4X,
$ '6. Last column zero' )
*
* GB matrix types
*
9988 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X,
$ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
$ '2. First column zero', 15X, '6. Random, CNDNUM = 0.1/EPS',
$ / 4X, '3. Last column zero', 16X,
$ '7. Scaled near underflow', / 4X,
$ '4. Last n/2 columns zero', 11X, '8. Scaled near overflow' )
*
* GT matrix types
*
9987 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
$ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM',
$ / 4X, '2. Random, CNDNUM = 2', 14X, '8. First column zero',
$ / 4X, '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X,
$ '9. Last column zero', / 4X, '4. Random, CNDNUM = 0.1/EPS',
$ 7X, '10. Last n/2 columns zero', / 4X,
$ '5. Scaled near underflow', 10X,
$ '11. Scaled near underflow', / 4X,
$ '6. Scaled near overflow', 11X, '12. Scaled near overflow' )
*
* PT matrix types
*
9986 FORMAT( ' Matrix types (1-6 have specified condition numbers):',
$ / 4X, '1. Diagonal', 24X, '7. Random, unspecified CNDNUM',
$ / 4X, '2. Random, CNDNUM = 2', 14X,
$ '8. First row and column zero', / 4X,
$ '3. Random, CNDNUM = sqrt(0.1/EPS)', 2X,
$ '9. Last row and column zero', / 4X,
$ '4. Random, CNDNUM = 0.1/EPS', 7X,
$ '10. Middle row and column zero', / 4X,
$ '5. Scaled near underflow', 10X,
$ '11. Scaled near underflow', / 4X,
$ '6. Scaled near overflow', 11X, '12. Scaled near overflow' )
*
* PO, PP matrix types
*
9985 FORMAT( 4X, '1. Diagonal', 24X,
$ '6. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
$ '2. Random, CNDNUM = 2', 14X, '7. Random, CNDNUM = 0.1/EPS',
$ / 3X, '*3. First row and column zero', 7X,
$ '8. Scaled near underflow', / 3X,
$ '*4. Last row and column zero', 8X,
$ '9. Scaled near overflow', / 3X,
$ '*5. Middle row and column zero', / 3X,
$ '(* - tests error exits from ', A3,
$ 'TRF, no test ratios are computed)' )
*
* PB matrix types
*
9984 FORMAT( 4X, '1. Random, CNDNUM = 2', 14X,
$ '5. Random, CNDNUM = sqrt(0.1/EPS)', / 3X,
$ '*2. First row and column zero', 7X,
$ '6. Random, CNDNUM = 0.1/EPS', / 3X,
$ '*3. Last row and column zero', 8X,
$ '7. Scaled near underflow', / 3X,
$ '*4. Middle row and column zero', 6X,
$ '8. Scaled near overflow', / 3X,
$ '(* - tests error exits from ', A3,
$ 'TRF, no test ratios are computed)' )
*
* SSY, SSP, CHE, CHP matrix types
*
9983 FORMAT( 4X, '1. Diagonal', 24X,
$ '6. Last n/2 rows and columns zero', / 4X,
$ '2. Random, CNDNUM = 2', 14X,
$ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
$ '3. First row and column zero', 7X,
$ '8. Random, CNDNUM = 0.1/EPS', / 4X,
$ '4. Last row and column zero', 8X,
$ '9. Scaled near underflow', / 4X,
$ '5. Middle row and column zero', 5X,
$ '10. Scaled near overflow' )
*
* CSY, CSP matrix types
*
9982 FORMAT( 4X, '1. Diagonal', 24X,
$ '7. Random, CNDNUM = sqrt(0.1/EPS)', / 4X,
$ '2. Random, CNDNUM = 2', 14X, '8. Random, CNDNUM = 0.1/EPS',
$ / 4X, '3. First row and column zero', 7X,
$ '9. Scaled near underflow', / 4X,
$ '4. Last row and column zero', 7X,
$ '10. Scaled near overflow', / 4X,
$ '5. Middle row and column zero', 5X,
$ '11. Block diagonal matrix', / 4X,
$ '6. Last n/2 rows and columns zero' )
*
* Test ratios
*
9981 FORMAT( 3X, I2, ': norm( L * U - A ) / ( N * norm(A) * EPS )' )
9980 FORMAT( 3X, I2, ': norm( B - A * X ) / ',
$ '( norm(A) * norm(X) * EPS )' )
9979 FORMAT( 3X, I2, ': norm( X - XACT ) / ',
$ '( norm(XACT) * CNDNUM * EPS )' )
9978 FORMAT( 3X, I2, ': norm( X - XACT ) / ',
$ '( norm(XACT) * (error bound) )' )
9977 FORMAT( 3X, I2, ': (backward error) / EPS' )
9976 FORMAT( 3X, I2, ': RCOND * CNDNUM - 1.0' )
9975 FORMAT( 3X, I2, ': norm( U'' * U - A ) / ( N * norm(A) * EPS )',
$ ', or', / 7X, 'norm( L * L'' - A ) / ( N * norm(A) * EPS )'
$ )
9974 FORMAT( 3X, I2, ': norm( U*D*U'' - A ) / ( N * norm(A) * EPS )',
$ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
$ )
9973 FORMAT( 3X, I2, ': norm( U''*D*U - A ) / ( N * norm(A) * EPS )',
$ ', or', / 7X, 'norm( L*D*L'' - A ) / ( N * norm(A) * EPS )'
$ )
9972 FORMAT( 3X, I2, ': abs( WORK(1) - RPVGRW ) /',
$ ' ( max( WORK(1), RPVGRW ) * EPS )' )
*
RETURN
*
* End of ALADHD
*
END