cerrvx.f

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

F
761 行
字号
123
*
         SRNAMT = 'CPTSVX'
         INFOT = 1
         CALL CPTSVX( '/', 0, 0, R, A( 1, 1 ), RF, AF( 1, 1 ), B, 1, X,
     $                1, RCOND, R1, R2, W, RW, INFO )
         CALL CHKXER( 'CPTSVX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CPTSVX( 'N', -1, 0, R, A( 1, 1 ), RF, AF( 1, 1 ), B, 1, X,
     $                1, RCOND, R1, R2, W, RW, INFO )
         CALL CHKXER( 'CPTSVX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CPTSVX( 'N', 0, -1, R, A( 1, 1 ), RF, AF( 1, 1 ), B, 1, X,
     $                1, RCOND, R1, R2, W, RW, INFO )
         CALL CHKXER( 'CPTSVX', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL CPTSVX( 'N', 2, 0, R, A( 1, 1 ), RF, AF( 1, 1 ), B, 1, X,
     $                2, RCOND, R1, R2, W, RW, INFO )
         CALL CHKXER( 'CPTSVX', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL CPTSVX( 'N', 2, 0, R, A( 1, 1 ), RF, AF( 1, 1 ), B, 2, X,
     $                1, RCOND, R1, R2, W, RW, INFO )
         CALL CHKXER( 'CPTSVX', INFOT, NOUT, LERR, OK )
*
      ELSE IF( LSAMEN( 2, C2, 'HE' ) ) THEN
*
*        CHESV
*
         SRNAMT = 'CHESV '
         INFOT = 1
         CALL CHESV( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CHESV( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CHESV( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CHESV( 'U', 2, 0, A, 1, IP, B, 2, W, 1, INFO )
         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CHESV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CHESV ', INFOT, NOUT, LERR, OK )
*
*        CHESVX
*
         SRNAMT = 'CHESVX'
         INFOT = 1
         CALL CHESVX( '/', 'U', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CHESVX( 'N', '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CHESVX( 'N', 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CHESVX( 'N', 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL CHESVX( 'N', 'U', 2, 0, A, 1, AF, 2, IP, B, 2, X, 2,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CHESVX( 'N', 'U', 2, 0, A, 2, AF, 1, IP, B, 2, X, 2,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL CHESVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 1, X, 2,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 13
         CALL CHESVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 2, X, 1,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL CHESVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 2, X, 2,
     $                RCOND, R1, R2, W, 3, RW, INFO )
         CALL CHKXER( 'CHESVX', INFOT, NOUT, LERR, OK )
*
      ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
*
*        CHPSV
*
         SRNAMT = 'CHPSV '
         INFOT = 1
         CALL CHPSV( '/', 0, 0, A, IP, B, 1, INFO )
         CALL CHKXER( 'CHPSV ', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CHPSV( 'U', -1, 0, A, IP, B, 1, INFO )
         CALL CHKXER( 'CHPSV ', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CHPSV( 'U', 0, -1, A, IP, B, 1, INFO )
         CALL CHKXER( 'CHPSV ', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL CHPSV( 'U', 2, 0, A, IP, B, 1, INFO )
         CALL CHKXER( 'CHPSV ', INFOT, NOUT, LERR, OK )
*
*        CHPSVX
*
         SRNAMT = 'CHPSVX'
         INFOT = 1
         CALL CHPSVX( '/', 'U', 0, 0, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CHPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CHPSVX( 'N', '/', 0, 0, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CHPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CHPSVX( 'N', 'U', -1, 0, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CHPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CHPSVX( 'N', 'U', 0, -1, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CHPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL CHPSVX( 'N', 'U', 2, 0, A, AF, IP, B, 1, X, 2, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CHPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL CHPSVX( 'N', 'U', 2, 0, A, AF, IP, B, 2, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CHPSVX', INFOT, NOUT, LERR, OK )
*
      ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN
*
*        CSYSV
*
         SRNAMT = 'CSYSV '
         INFOT = 1
         CALL CSYSV( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CSYSV( 'U', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CSYSV( 'U', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CSYSV( 'U', 2, 0, A, 2, IP, B, 1, W, 1, INFO )
         CALL CHKXER( 'CSYSV ', INFOT, NOUT, LERR, OK )
*
*        CSYSVX
*
         SRNAMT = 'CSYSVX'
         INFOT = 1
         CALL CSYSVX( '/', 'U', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CSYSVX( 'N', '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CSYSVX( 'N', 'U', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CSYSVX( 'N', 'U', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1,
     $                RCOND, R1, R2, W, 1, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL CSYSVX( 'N', 'U', 2, 0, A, 1, AF, 2, IP, B, 2, X, 2,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CSYSVX( 'N', 'U', 2, 0, A, 2, AF, 1, IP, B, 2, X, 2,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL CSYSVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 1, X, 2,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 13
         CALL CSYSVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 2, X, 1,
     $                RCOND, R1, R2, W, 4, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL CSYSVX( 'N', 'U', 2, 0, A, 2, AF, 2, IP, B, 2, X, 2,
     $                RCOND, R1, R2, W, 3, RW, INFO )
         CALL CHKXER( 'CSYSVX', INFOT, NOUT, LERR, OK )
*
      ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN
*
*        CSPSV
*
         SRNAMT = 'CSPSV '
         INFOT = 1
         CALL CSPSV( '/', 0, 0, A, IP, B, 1, INFO )
         CALL CHKXER( 'CSPSV ', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CSPSV( 'U', -1, 0, A, IP, B, 1, INFO )
         CALL CHKXER( 'CSPSV ', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CSPSV( 'U', 0, -1, A, IP, B, 1, INFO )
         CALL CHKXER( 'CSPSV ', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL CSPSV( 'U', 2, 0, A, IP, B, 1, INFO )
         CALL CHKXER( 'CSPSV ', INFOT, NOUT, LERR, OK )
*
*        CSPSVX
*
         SRNAMT = 'CSPSVX'
         INFOT = 1
         CALL CSPSVX( '/', 'U', 0, 0, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CSPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CSPSVX( 'N', '/', 0, 0, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CSPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CSPSVX( 'N', 'U', -1, 0, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CSPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CSPSVX( 'N', 'U', 0, -1, A, AF, IP, B, 1, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CSPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL CSPSVX( 'N', 'U', 2, 0, A, AF, IP, B, 1, X, 2, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CSPSVX', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL CSPSVX( 'N', 'U', 2, 0, A, AF, IP, B, 2, X, 1, RCOND, R1,
     $                R2, W, RW, INFO )
         CALL CHKXER( 'CSPSVX', INFOT, NOUT, LERR, OK )
      END IF
*
*     Print a summary line.
*
      IF( OK ) THEN
         WRITE( NOUT, FMT = 9999 )PATH
      ELSE
         WRITE( NOUT, FMT = 9998 )PATH
      END IF
*
 9999 FORMAT( 1X, A3, ' drivers passed the tests of the error exits' )
 9998 FORMAT( ' *** ', A3, ' drivers failed the tests of the error ',
     $      'exits ***' )
*
      RETURN
*
*     End of CERRVX
*
      END
123

cerrvx.f - 源码说明

本页面展示了「famous linear algebra library (LAPACK) ports to windows」中的 cerrvx.f 源码文件，采用 F 编程语言编写，共 761 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与algebra相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

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