alahd.f

来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 730 行 · 第 1/2 页
730 行
      SUBROUTINE ALAHD( IOUNIT, PATH )
*
*  -- LAPACK test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      CHARACTER*3        PATH
      INTEGER            IOUNIT
*     ..
*
*  Purpose
*  =======
*
*  ALAHD prints header information for the different test paths.
*
*  Arguments
*  =========
*
*  IOUNIT  (input) INTEGER
*          The unit number to which the header information should be
*          printed.
*
*  PATH    (input) 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
*             _PP:  Symmetric or Hermitian positive definite packed
*             _PB:  Symmetric or Hermitian positive definite band
*             _PT:  Symmetric or Hermitian positive definite tridiagonal
*             _SY:  Symmetric indefinite
*             _SP:  Symmetric indefinite packed
*             _HE:  (complex) Hermitian indefinite
*             _HP:  (complex) Hermitian indefinite packed
*             _TR:  Triangular
*             _TP:  Triangular packed
*             _TB:  Triangular band
*             _QR:  QR (general matrices)
*             _LQ:  LQ (general matrices)
*             _QL:  QL (general matrices)
*             _RQ:  RQ (general matrices)
*             _QP:  QR with column pivoting
*             _TZ:  Trapezoidal
*             _LS:  Least Squares driver routines
*             _LU:  LU variants
*             _CH:  Cholesky variants
*             _QS:  QR variants
*          The first character must be one of S, D, C, or Z (C or Z only
*          if complex).
*
*  =====================================================================
*
*     .. Local Scalars ..
      LOGICAL            CORZ, SORD
      CHARACTER          C1, C3
      CHARACTER*2        P2
      CHARACTER*6        SUBNAM
      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 = 9979 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9962 )1
         WRITE( IOUNIT, FMT = 9961 )2
         WRITE( IOUNIT, FMT = 9960 )3
         WRITE( IOUNIT, FMT = 9959 )4
         WRITE( IOUNIT, FMT = 9958 )5
         WRITE( IOUNIT, FMT = 9957 )6
         WRITE( IOUNIT, FMT = 9956 )7
         WRITE( IOUNIT, FMT = 9955 )8
         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 = 9978 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9962 )1
         WRITE( IOUNIT, FMT = 9960 )2
         WRITE( IOUNIT, FMT = 9959 )3
         WRITE( IOUNIT, FMT = 9958 )4
         WRITE( IOUNIT, FMT = 9957 )5
         WRITE( IOUNIT, FMT = 9956 )6
         WRITE( IOUNIT, FMT = 9955 )7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'GT' ) ) THEN
*
*        GT: General tridiagonal
*
         WRITE( IOUNIT, FMT = 9997 )PATH
         WRITE( IOUNIT, FMT = 9977 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9962 )1
         WRITE( IOUNIT, FMT = 9960 )2
         WRITE( IOUNIT, FMT = 9959 )3
         WRITE( IOUNIT, FMT = 9958 )4
         WRITE( IOUNIT, FMT = 9957 )5
         WRITE( IOUNIT, FMT = 9956 )6
         WRITE( IOUNIT, FMT = 9955 )7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'PO' ) .OR. LSAMEN( 2, P2, 'PP' ) ) THEN
*
*        PO: 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 = 9975 )PATH
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9954 )1
         WRITE( IOUNIT, FMT = 9961 )2
         WRITE( IOUNIT, FMT = 9960 )3
         WRITE( IOUNIT, FMT = 9959 )4
         WRITE( IOUNIT, FMT = 9958 )5
         WRITE( IOUNIT, FMT = 9957 )6
         WRITE( IOUNIT, FMT = 9956 )7
         WRITE( IOUNIT, FMT = 9955 )8
         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 = 9973 )PATH
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9954 )1
         WRITE( IOUNIT, FMT = 9960 )2
         WRITE( IOUNIT, FMT = 9959 )3
         WRITE( IOUNIT, FMT = 9958 )4
         WRITE( IOUNIT, FMT = 9957 )5
         WRITE( IOUNIT, FMT = 9956 )6
         WRITE( IOUNIT, FMT = 9955 )7
         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 = 9976 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9952 )1
         WRITE( IOUNIT, FMT = 9960 )2
         WRITE( IOUNIT, FMT = 9959 )3
         WRITE( IOUNIT, FMT = 9958 )4
         WRITE( IOUNIT, FMT = 9957 )5
         WRITE( IOUNIT, FMT = 9956 )6
         WRITE( IOUNIT, FMT = 9955 )7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'SY' ) .OR. LSAMEN( 2, P2, 'SP' ) ) THEN
*
*        SY: Symmetric indefinite full
*        SP: Symmetric indefinite packed
*
         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 = 9972 )
         ELSE
            WRITE( IOUNIT, FMT = 9971 )
         END IF
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9953 )1
         WRITE( IOUNIT, FMT = 9961 )2
         WRITE( IOUNIT, FMT = 9960 )3
         WRITE( IOUNIT, FMT = 9959 )4
         WRITE( IOUNIT, FMT = 9958 )5
         WRITE( IOUNIT, FMT = 9956 )6
         WRITE( IOUNIT, FMT = 9957 )7
         WRITE( IOUNIT, FMT = 9955 )8
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. LSAMEN( 2, P2, 'HP' ) ) THEN
*
*        HE: Hermitian indefinite full
*        HP: Hermitian indefinite packed
*
         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 = 9972 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9953 )1
         WRITE( IOUNIT, FMT = 9961 )2
         WRITE( IOUNIT, FMT = 9960 )3
         WRITE( IOUNIT, FMT = 9959 )4
         WRITE( IOUNIT, FMT = 9958 )5
         WRITE( IOUNIT, FMT = 9956 )6
         WRITE( IOUNIT, FMT = 9957 )7
         WRITE( IOUNIT, FMT = 9955 )8
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'TR' ) .OR. LSAMEN( 2, P2, 'TP' ) ) THEN
*
*        TR: Triangular full
*        TP: Triangular packed
*
         IF( LSAME( C3, 'R' ) ) THEN
            WRITE( IOUNIT, FMT = 9990 )PATH
            SUBNAM = PATH( 1: 1 ) // 'LATRS'
         ELSE
            WRITE( IOUNIT, FMT = 9989 )PATH
            SUBNAM = PATH( 1: 1 ) // 'LATPS'
         END IF
         WRITE( IOUNIT, FMT = 9966 )PATH
         WRITE( IOUNIT, FMT = 9965 )SUBNAM
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9961 )1
         WRITE( IOUNIT, FMT = 9960 )2
         WRITE( IOUNIT, FMT = 9959 )3
         WRITE( IOUNIT, FMT = 9958 )4
         WRITE( IOUNIT, FMT = 9957 )5
         WRITE( IOUNIT, FMT = 9956 )6
         WRITE( IOUNIT, FMT = 9955 )7
         WRITE( IOUNIT, FMT = 9951 )SUBNAM, 8
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'TB' ) ) THEN
*
*        TB: Triangular band
*
         WRITE( IOUNIT, FMT = 9988 )PATH
         SUBNAM = PATH( 1: 1 ) // 'LATBS'
         WRITE( IOUNIT, FMT = 9964 )PATH
         WRITE( IOUNIT, FMT = 9963 )SUBNAM
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9960 )1
         WRITE( IOUNIT, FMT = 9959 )2
         WRITE( IOUNIT, FMT = 9958 )3
         WRITE( IOUNIT, FMT = 9957 )4
         WRITE( IOUNIT, FMT = 9956 )5
         WRITE( IOUNIT, FMT = 9955 )6
         WRITE( IOUNIT, FMT = 9951 )SUBNAM, 7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'QR' ) ) THEN
*
*        QR decomposition of rectangular matrices
*
         WRITE( IOUNIT, FMT = 9987 )PATH, 'QR'
         WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
         WRITE( IOUNIT, FMT = 9970 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9950 )1
         WRITE( IOUNIT, FMT = 9946 )2
         WRITE( IOUNIT, FMT = 9944 )3, 'M'
         WRITE( IOUNIT, FMT = 9943 )4, 'M'
         WRITE( IOUNIT, FMT = 9942 )5, 'M'
         WRITE( IOUNIT, FMT = 9941 )6, 'M'
         WRITE( IOUNIT, FMT = 9960 )7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'LQ' ) ) THEN
*
*        LQ decomposition of rectangular matrices
*
         WRITE( IOUNIT, FMT = 9987 )PATH, 'LQ'
         WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
         WRITE( IOUNIT, FMT = 9970 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9949 )1
         WRITE( IOUNIT, FMT = 9945 )2
         WRITE( IOUNIT, FMT = 9944 )3, 'N'
         WRITE( IOUNIT, FMT = 9943 )4, 'N'
         WRITE( IOUNIT, FMT = 9942 )5, 'N'
         WRITE( IOUNIT, FMT = 9941 )6, 'N'
         WRITE( IOUNIT, FMT = 9960 )7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'QL' ) ) THEN
*
*        QL decomposition of rectangular matrices
*
         WRITE( IOUNIT, FMT = 9987 )PATH, 'QL'
         WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
         WRITE( IOUNIT, FMT = 9970 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9948 )1
         WRITE( IOUNIT, FMT = 9946 )2
         WRITE( IOUNIT, FMT = 9944 )3, 'M'
         WRITE( IOUNIT, FMT = 9943 )4, 'M'
         WRITE( IOUNIT, FMT = 9942 )5, 'M'
         WRITE( IOUNIT, FMT = 9941 )6, 'M'
         WRITE( IOUNIT, FMT = 9960 )7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'RQ' ) ) THEN
*
*        RQ decomposition of rectangular matrices
*
         WRITE( IOUNIT, FMT = 9987 )PATH, 'RQ'
         WRITE( IOUNIT, FMT = '( '' Matrix types:'' )' )
         WRITE( IOUNIT, FMT = 9970 )
         WRITE( IOUNIT, FMT = '( '' Test ratios:'' )' )
         WRITE( IOUNIT, FMT = 9947 )1
         WRITE( IOUNIT, FMT = 9945 )2
         WRITE( IOUNIT, FMT = 9944 )3, 'N'
         WRITE( IOUNIT, FMT = 9943 )4, 'N'
         WRITE( IOUNIT, FMT = 9942 )5, 'N'
         WRITE( IOUNIT, FMT = 9941 )6, 'N'
         WRITE( IOUNIT, FMT = 9960 )7
         WRITE( IOUNIT, FMT = '( '' Messages:'' )' )
*
      ELSE IF( LSAMEN( 2, P2, 'QP' ) ) THEN
*
*        QR decomposition with column pivoting
*
         WRITE( IOUNIT, FMT = 9986 )PATH
         WRITE( IOUNIT, FMT = 9969 )
alahd.f - 源码说明

本页面展示了「famous linear algebra library (LAPACK) ports to windows」中的 alahd.f 源码文件，采用 F 编程语言编写，共 730 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。
虫虫下载站收录了大量与algebra相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。
⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?