serrgg.f

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

F
954 行
字号
123
         CALL SGGEV( 'N', '/', 1, A, 1, B, 1, R1, R2, R3, Q, 1, U, 1, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGEV( 'V', 'V', -1, A, 1, B, 1, R1, R2, R3, Q, 1, U, 1,
     $               W, 1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGEV( 'V', 'V', 1, A, 0, B, 1, R1, R2, R3, Q, 1, U, 1, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL SGGEV( 'V', 'V', 1, A, 1, B, 0, R1, R2, R3, Q, 1, U, 1, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL SGGEV( 'N', 'V', 1, A, 1, B, 1, R1, R2, R3, Q, 0, U, 1, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL SGGEV( 'V', 'V', 2, A, 2, B, 2, R1, R2, R3, Q, 1, U, 2, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL SGGEV( 'V', 'N', 2, A, 2, B, 2, R1, R2, R3, Q, 2, U, 0, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL SGGEV( 'V', 'V', 2, A, 2, B, 2, R1, R2, R3, Q, 2, U, 1, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL SGGEV( 'V', 'V', 1, A, 1, B, 1, R1, R2, R3, Q, 1, U, 1, W,
     $               1, INFO )
         CALL CHKXER( 'SGGEV ', INFOT, NOUT, LERR, OK )
         NT = NT + 10
*
*        SGGEVX
*
         SRNAMT = 'SGGEVX'
         INFOT = 1
         CALL SGGEVX( '/', 'N', 'N', 'N', 1, A, 1, B, 1, R1, R2, R3, Q,
     $                1, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGEVX( 'N', '/', 'N', 'N', 1, A, 1, B, 1, R1, R2, R3, Q,
     $                1, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGEVX( 'N', 'N', '/', 'N', 1, A, 1, B, 1, R1, R2, R3, Q,
     $                1, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL SGGEVX( 'N', 'N', 'N', '/', 1, A, 1, B, 1, R1, R2, R3, Q,
     $                1, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGEVX( 'N', 'N', 'N', 'N', -1, A, 1, B, 1, R1, R2, R3, Q,
     $                1, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL SGGEVX( 'N', 'N', 'N', 'N', 1, A, 0, B, 1, R1, R2, R3, Q,
     $                1, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL SGGEVX( 'N', 'N', 'N', 'N', 1, A, 1, B, 0, R1, R2, R3, Q,
     $                1, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL SGGEVX( 'N', 'N', 'N', 'N', 1, A, 1, B, 1, R1, R2, R3, Q,
     $                0, U, 1, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL SGGEVX( 'N', 'V', 'N', 'N', 2, A, 2, B, 2, R1, R2, R3, Q,
     $                1, U, 2, 1, 2, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL SGGEVX( 'N', 'N', 'N', 'N', 1, A, 1, B, 1, R1, R2, R3, Q,
     $                1, U, 0, 1, 1, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL SGGEVX( 'N', 'N', 'V', 'N', 2, A, 2, B, 2, R1, R2, R3, Q,
     $                2, U, 1, 1, 2, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         INFOT = 26
         CALL SGGEVX( 'N', 'N', 'V', 'N', 2, A, 2, B, 2, R1, R2, R3, Q,
     $                2, U, 2, 1, 2, LS, RS, ANRM, BNRM, RCE, RCV, W, 1,
     $                IW, BW, INFO )
         CALL CHKXER( 'SGGEVX', INFOT, NOUT, LERR, OK )
         NT = NT + 12
*
*        STGEXC
*
         SRNAMT = 'STGEXC'
         INFOT = 3
         CALL STGEXC( .TRUE., .TRUE., -1, A, 1, B, 1, Q, 1, Z, 1, IFST,
     $                ILST, W, 1, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STGEXC( .TRUE., .TRUE., 1, A, 0, B, 1, Q, 1, Z, 1, IFST,
     $                ILST, W, 1, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL STGEXC( .TRUE., .TRUE., 1, A, 1, B, 0, Q, 1, Z, 1, IFST,
     $                ILST, W, 1, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL STGEXC( .FALSE., .TRUE., 1, A, 1, B, 1, Q, 0, Z, 1, IFST,
     $                ILST, W, 1, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL STGEXC( .TRUE., .TRUE., 1, A, 1, B, 1, Q, 0, Z, 1, IFST,
     $                ILST, W, 1, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL STGEXC( .TRUE., .FALSE., 1, A, 1, B, 1, Q, 1, Z, 0, IFST,
     $                ILST, W, 1, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL STGEXC( .TRUE., .TRUE., 1, A, 1, B, 1, Q, 1, Z, 0, IFST,
     $                ILST, W, 1, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         INFOT = 15
         CALL STGEXC( .TRUE., .TRUE., 1, A, 1, B, 1, Q, 1, Z, 1, IFST,
     $                ILST, W, 0, INFO )
         CALL CHKXER( 'STGEXC', INFOT, NOUT, LERR, OK )
         NT = NT + 8
*
*        STGSEN
*
         SRNAMT = 'STGSEN'
         INFOT = 1
         CALL STGSEN( -1, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2,
     $                R3, Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STGSEN( 1, .TRUE., .TRUE., SEL, -1, A, 1, B, 1, R1, R2,
     $                R3, Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL STGSEN( 1, .TRUE., .TRUE., SEL, 1, A, 0, B, 1, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL STGSEN( 1, .TRUE., .TRUE., SEL, 1, A, 1, B, 0, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL STGSEN( 1, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 0, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL STGSEN( 1, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 1, Z, 0, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 22
         CALL STGSEN( 0, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 22
         CALL STGSEN( 1, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 22
         CALL STGSEN( 2, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 1, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 24
         CALL STGSEN( 0, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 20, IW, 0,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 24
         CALL STGSEN( 1, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 20, IW, 0,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         INFOT = 24
         CALL STGSEN( 2, .TRUE., .TRUE., SEL, 1, A, 1, B, 1, R1, R2, R3,
     $                Q, 1, Z, 1, M, TOLA, TOLB, RCV, W, 20, IW, 1,
     $                INFO )
         CALL CHKXER( 'STGSEN', INFOT, NOUT, LERR, OK )
         NT = NT + 12
*
*        STGSNA
*
         SRNAMT = 'STGSNA'
         INFOT = 1
         CALL STGSNA( '/', 'A', SEL, 1, A, 1, B, 1, Q, 1, U, 1, R1, R2,
     $                1, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STGSNA( 'B', '/', SEL, 1, A, 1, B, 1, Q, 1, U, 1, R1, R2,
     $                1, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STGSNA( 'B', 'A', SEL, -1, A, 1, B, 1, Q, 1, U, 1, R1, R2,
     $                1, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL STGSNA( 'B', 'A', SEL, 1, A, 0, B, 1, Q, 1, U, 1, R1, R2,
     $                1, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL STGSNA( 'B', 'A', SEL, 1, A, 1, B, 0, Q, 1, U, 1, R1, R2,
     $                1, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL STGSNA( 'E', 'A', SEL, 1, A, 1, B, 1, Q, 0, U, 1, R1, R2,
     $                1, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL STGSNA( 'E', 'A', SEL, 1, A, 1, B, 1, Q, 1, U, 0, R1, R2,
     $                1, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 15
         CALL STGSNA( 'E', 'A', SEL, 1, A, 1, B, 1, Q, 1, U, 1, R1, R2,
     $                0, M, W, 1, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL STGSNA( 'E', 'A', SEL, 1, A, 1, B, 1, Q, 1, U, 1, R1, R2,
     $                1, M, W, 0, IW, INFO )
         CALL CHKXER( 'STGSNA', INFOT, NOUT, LERR, OK )
         NT = NT + 9
*
*        STGSYL
*
         SRNAMT = 'STGSYL'
         INFOT = 1
         CALL STGSYL( '/', 0, 1, 1, A, 1, B, 1, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STGSYL( 'N', -1, 1, 1, A, 1, B, 1, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STGSYL( 'N', 0, 0, 1, A, 1, B, 1, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STGSYL( 'N', 0, 1, 0, A, 1, B, 1, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL STGSYL( 'N', 0, 1, 1, A, 0, B, 1, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL STGSYL( 'N', 0, 1, 1, A, 1, B, 0, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL STGSYL( 'N', 0, 1, 1, A, 1, B, 1, Q, 0, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL STGSYL( 'N', 0, 1, 1, A, 1, B, 1, Q, 1, U, 0, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL STGSYL( 'N', 0, 1, 1, A, 1, B, 1, Q, 1, U, 1, V, 0, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL STGSYL( 'N', 0, 1, 1, A, 1, B, 1, Q, 1, U, 1, V, 1, Z, 0,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 20
         CALL STGSYL( 'N', 1, 1, 1, A, 1, B, 1, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         INFOT = 20
         CALL STGSYL( 'N', 2, 1, 1, A, 1, B, 1, Q, 1, U, 1, V, 1, Z, 1,
     $                SCALE, DIF, W, 1, IW, INFO )
         CALL CHKXER( 'STGSYL', INFOT, NOUT, LERR, OK )
         NT = NT + 12
      END IF
*
*     Print a summary line.
*
      IF( OK ) THEN
         WRITE( NOUT, FMT = 9999 )PATH, NT
      ELSE
         WRITE( NOUT, FMT = 9998 )PATH
      END IF
*
 9999 FORMAT( 1X, A3, ' routines passed the tests of the error exits (',
     $      I3, ' tests done)' )
 9998 FORMAT( ' *** ', A3, ' routines failed the tests of the error ',
     $      'exits ***' )
*
      RETURN
*
*     End of SERRGG
*
      END
123

serrgg.f - 源码说明

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

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

⌨️ 快捷键说明

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