serrgg.f

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

         CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
         INFOT = 20
         CALL SGGSVP( 'N', 'N', 'Q', 1, 1, 2, A, 1, B, 1, TOLA, TOLB,
     $                DUMMYK, DUMMYL, U, 1, V, 1, Q, 1, IW, TAU, W,
     $                INFO )
         CALL CHKXER( 'SGGSVP', INFOT, NOUT, LERR, OK )
         NT = NT + 11
*
*        STGSJA
*
         SRNAMT = 'STGSJA'
         INFOT = 1
         CALL STGSJA( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STGSJA( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STGSJA( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STGSJA( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STGSJA( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL STGSJA( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL STGSJA( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 0, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL STGSJA( 'N', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                0, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL STGSJA( 'U', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 0, V, 1, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 20
         CALL STGSJA( 'N', 'V', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 0, Q, 1, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 22
         CALL STGSJA( 'N', 'N', 'Q', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B,
     $                1, TOLA, TOLB, R1, R2, U, 1, V, 1, Q, 0, W,
     $                NCYCLE, INFO )
         CALL CHKXER( 'STGSJA', INFOT, NOUT, LERR, OK )
         NT = NT + 11
*
*     Test error exits for the GLM path.
*
      ELSE IF( LSAMEN( 3, PATH, 'GLM' ) ) THEN
*
*        SGGGLM
*
         SRNAMT = 'SGGGLM'
         INFOT = 1
         CALL SGGGLM( -1, 0, 0, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGGLM( 0, -1, 0, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGGLM( 0, 1, 0, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGGLM( 0, 0, -1, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGGLM( 1, 0, 0, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGGLM( 0, 0, 0, A, 0, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL SGGGLM( 0, 0, 0, A, 1, B, 0, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL SGGGLM( 1, 1, 1, A, 1, B, 1, R1, R2, R3, W, 1, INFO )
         CALL CHKXER( 'SGGGLM', INFOT, NOUT, LERR, OK )
         NT = NT + 8
*
*     Test error exits for the LSE path.
*
      ELSE IF( LSAMEN( 3, PATH, 'LSE' ) ) THEN
*
*        SGGLSE
*
         SRNAMT = 'SGGLSE'
         INFOT = 1
         CALL SGGLSE( -1, 0, 0, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGLSE( 0, -1, 0, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGLSE( 0, 0, -1, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGLSE( 0, 0, 1, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGLSE( 0, 1, 0, A, 1, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGLSE( 0, 0, 0, A, 0, B, 1, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL SGGLSE( 0, 0, 0, A, 1, B, 0, R1, R2, R3, W, LW, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL SGGLSE( 1, 1, 1, A, 1, B, 1, R1, R2, R3, W, 1, INFO )
         CALL CHKXER( 'SGGLSE', INFOT, NOUT, LERR, OK )
         NT = NT + 8
*
*     Test error exits for the GQR path.
*
      ELSE IF( LSAMEN( 3, PATH, 'GQR' ) ) THEN
*
*        SGGQRF
*
         SRNAMT = 'SGGQRF'
         INFOT = 1
         CALL SGGQRF( -1, 0, 0, A, 1, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGQRF( 0, -1, 0, A, 1, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGQRF( 0, 0, -1, A, 1, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGQRF( 0, 0, 0, A, 0, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL SGGQRF( 0, 0, 0, A, 1, R1, B, 0, R2, W, LW, INFO )
         CALL CHKXER( 'SGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL SGGQRF( 1, 1, 2, A, 1, R1, B, 1, R2, W, 1, INFO )
         CALL CHKXER( 'SGGQRF', INFOT, NOUT, LERR, OK )
         NT = NT + 6
*
*        SGGRQF
*
         SRNAMT = 'SGGRQF'
         INFOT = 1
         CALL SGGRQF( -1, 0, 0, A, 1, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGRQF( 0, -1, 0, A, 1, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGRQF( 0, 0, -1, A, 1, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGRQF( 0, 0, 0, A, 0, R1, B, 1, R2, W, LW, INFO )
         CALL CHKXER( 'SGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL SGGRQF( 0, 0, 0, A, 1, R1, B, 0, R2, W, LW, INFO )
         CALL CHKXER( 'SGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL SGGRQF( 1, 1, 2, A, 1, R1, B, 1, R2, W, 1, INFO )
         CALL CHKXER( 'SGGRQF', INFOT, NOUT, LERR, OK )
         NT = NT + 6
*
*     Test error exits for the SGS, SGV, SGX, and SXV paths.
*
      ELSE IF( LSAMEN( 3, PATH, 'SGS' ) .OR.
     $         LSAMEN( 3, PATH, 'SGV' ) .OR.
     $         LSAMEN( 3, PATH, 'SGX' ) .OR. LSAMEN( 3, PATH, 'SXV' ) )
     $          THEN
*
*        SGGES
*
         SRNAMT = 'SGGES '
         INFOT = 1
         CALL SGGES( '/', 'N', 'S', SLCTES, 1, A, 1, B, 1, SDIM, R1, R2,
     $               R3, Q, 1, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGES( 'N', '/', 'S', SLCTES, 1, A, 1, B, 1, SDIM, R1, R2,
     $               R3, Q, 1, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGES( 'N', 'V', '/', SLCTES, 1, A, 1, B, 1, SDIM, R1, R2,
     $               R3, Q, 1, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGES( 'N', 'V', 'S', SLCTES, -1, A, 1, B, 1, SDIM, R1,
     $               R2, R3, Q, 1, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL SGGES( 'N', 'V', 'S', SLCTES, 1, A, 0, B, 1, SDIM, R1, R2,
     $               R3, Q, 1, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL SGGES( 'N', 'V', 'S', SLCTES, 1, A, 1, B, 0, SDIM, R1, R2,
     $               R3, Q, 1, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 15
         CALL SGGES( 'N', 'V', 'S', SLCTES, 1, A, 1, B, 1, SDIM, R1, R2,
     $               R3, Q, 0, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 15
         CALL SGGES( 'V', 'V', 'S', SLCTES, 2, A, 2, B, 2, SDIM, R1, R2,
     $               R3, Q, 1, U, 2, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 17
         CALL SGGES( 'N', 'V', 'S', SLCTES, 1, A, 1, B, 1, SDIM, R1, R2,
     $               R3, Q, 1, U, 0, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 17
         CALL SGGES( 'V', 'V', 'S', SLCTES, 2, A, 2, B, 2, SDIM, R1, R2,
     $               R3, Q, 2, U, 1, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 19
         CALL SGGES( 'V', 'V', 'S', SLCTES, 2, A, 2, B, 2, SDIM, R1, R2,
     $               R3, Q, 2, U, 2, W, 1, BW, INFO )
         CALL CHKXER( 'SGGES ', INFOT, NOUT, LERR, OK )
         NT = NT + 11
*
*        SGGESX
*
         SRNAMT = 'SGGESX'
         INFOT = 1
         CALL SGGESX( '/', 'N', 'S', SLCTSX, 'N', 1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SGGESX( 'N', '/', 'S', SLCTSX, 'N', 1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SGGESX( 'V', 'V', '/', SLCTSX, 'N', 1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, '/', 1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', -1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', 1, A, 0, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', 1, A, 1, B, 0, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', 1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 0, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', 2, A, 2, B, 2, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', 1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 0, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', 2, A, 2, B, 2, SDIM,
     $                R1, R2, R3, Q, 2, U, 1, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 22
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'B', 2, A, 2, B, 2, SDIM,
     $                R1, R2, R3, Q, 2, U, 2, RCE, RCV, W, 1, IW, 1, BW,
     $                INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 24
         CALL SGGESX( 'V', 'V', 'S', SLCTSX, 'V', 1, A, 1, B, 1, SDIM,
     $                R1, R2, R3, Q, 1, U, 1, RCE, RCV, W, 32, IW, 0,
     $                BW, INFO )
         CALL CHKXER( 'SGGESX', INFOT, NOUT, LERR, OK )
         NT = NT + 13
*
*        SGGEV
*
         SRNAMT = 'SGGEV '
         INFOT = 1
         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 = 2