dlahd2.f

来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 469 行 · 第 1/2 页

      SUBROUTINE DLAHD2( IOUNIT, PATH )
*
*  -- LAPACK auxiliary test routine (version 2.0) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      CHARACTER*3        PATH
      INTEGER            IOUNIT
*     ..
*
*  Purpose
*  =======
*
*  DLAHD2 prints header information for the different test paths.
*
*  Arguments
*  =========
*
*  IOUNIT  (input) INTEGER.
*          On entry, IOUNIT specifies the unit number to which the
*          header information should be printed.
*
*  PATH    (input) CHARACTER*3.
*          On entry, PATH contains the name of the path for which the
*          header information is to be printed.  Current paths are
*
*             DHS, ZHS:  Non-symmetric eigenproblem.
*             DST, ZST:  Symmetric eigenproblem.
*             DSG, ZSG:  Symmetric Generalized eigenproblem.
*             DBD, ZBD:  Singular Value Decomposition (SVD)
*             DBB, ZBB:  General Banded reduction to bidiagonal form
*
*          These paths also are supplied in double precision (replace
*          leading S by D and leading C by Z in path names).
*
*  =====================================================================
*
*     .. Local Scalars ..
      LOGICAL            CORZ, SORD
      CHARACTER*2        C2
      INTEGER            J
*     ..
*     .. External Functions ..
      LOGICAL            LSAME, LSAMEN
      EXTERNAL           LSAME, LSAMEN
*     ..
*     .. Executable Statements ..
*
      IF( IOUNIT.LE.0 )
     $   RETURN
      SORD = LSAME( PATH, 'S' ) .OR. LSAME( PATH, 'D' )
      CORZ = LSAME( PATH, 'C' ) .OR. LSAME( PATH, 'Z' )
      IF( .NOT.SORD .AND. .NOT.CORZ ) THEN
         WRITE( IOUNIT, FMT = 9999 )PATH
      END IF
      C2 = PATH( 2: 3 )
*
      IF( LSAMEN( 2, C2, 'HS' ) ) THEN
         IF( SORD ) THEN
*
*           Real Non-symmetric Eigenvalue Problem:
*
            WRITE( IOUNIT, FMT = 9998 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9988 )
            WRITE( IOUNIT, FMT = 9987 )
            WRITE( IOUNIT, FMT = 9986 )'pairs ', 'pairs ', 'prs.',
     $         'prs.'
            WRITE( IOUNIT, FMT = 9985 )
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9984 )'orthogonal', '''=transpose',
     $         ( '''', J = 1, 6 )
*
         ELSE
*
*           Complex Non-symmetric Eigenvalue Problem:
*
            WRITE( IOUNIT, FMT = 9997 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9988 )
            WRITE( IOUNIT, FMT = 9987 )
            WRITE( IOUNIT, FMT = 9986 )'e.vals', 'e.vals', 'e.vs',
     $         'e.vs'
            WRITE( IOUNIT, FMT = 9985 )
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9984 )'unitary', '*=conj.transp.',
     $         ( '*', J = 1, 6 )
         END IF
*
      ELSE IF( LSAMEN( 2, C2, 'ST' ) ) THEN
*
         IF( SORD ) THEN
*
*           Real Symmetric Eigenvalue Problem:
*
            WRITE( IOUNIT, FMT = 9996 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9983 )
            WRITE( IOUNIT, FMT = 9982 )
            WRITE( IOUNIT, FMT = 9981 )'Symmetric'
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9968 )
*
         ELSE
*
*           Complex Hermitian Eigenvalue Problem:
*
            WRITE( IOUNIT, FMT = 9995 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9983 )
            WRITE( IOUNIT, FMT = 9982 )
            WRITE( IOUNIT, FMT = 9981 )'Hermitian'
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9967 )
         END IF
*
      ELSE IF( LSAMEN( 2, C2, 'SG' ) ) THEN
*
         IF( SORD ) THEN
*
*           Real Symmetric Generalized Eigenvalue Problem:
*
            WRITE( IOUNIT, FMT = 9992 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9980 )
            WRITE( IOUNIT, FMT = 9979 )
            WRITE( IOUNIT, FMT = 9978 )'Symmetric'
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9977 )
            WRITE( IOUNIT, FMT = 9976 )
*
         ELSE
*
*           Complex Hermitian Generalized Eigenvalue Problem:
*
            WRITE( IOUNIT, FMT = 9991 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9980 )
            WRITE( IOUNIT, FMT = 9979 )
            WRITE( IOUNIT, FMT = 9978 )'Hermitian'
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9975 )
            WRITE( IOUNIT, FMT = 9974 )
*
         END IF
*
      ELSE IF( LSAMEN( 2, C2, 'BD' ) ) THEN
*
         IF( SORD ) THEN
*
*           Real Singular Value Decomposition:
*
            WRITE( IOUNIT, FMT = 9994 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9973 )
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9972 )'orthogonal'
            WRITE( IOUNIT, FMT = 9971 )
         ELSE
*
*           Complex Singular Value Decomposition:
*
            WRITE( IOUNIT, FMT = 9993 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9973 )
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9972 )'unitary   '
            WRITE( IOUNIT, FMT = 9971 )
         END IF
*
      ELSE IF( LSAMEN( 2, C2, 'BB' ) ) THEN
*
         IF( SORD ) THEN
*
*           Real General Band reduction to bidiagonal form:
*
            WRITE( IOUNIT, FMT = 9990 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9970 )
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9969 )'orthogonal'
         ELSE
*
*           Complex Band reduction to bidiagonal form:
*
            WRITE( IOUNIT, FMT = 9989 )PATH
*
*           Matrix types
*
            WRITE( IOUNIT, FMT = 9970 )
*
*           Tests performed
*
            WRITE( IOUNIT, FMT = 9969 )'unitary   '
         END IF
*
      ELSE
*