zerrgg.f

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

         CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
         INFOT = 20
         CALL ZGGSVP( 'N', 'N', 'Q', 2, 2, 2, A, 2, B, 2, TOLA, TOLB,
     $                DUMMYK, DUMMYL, U, 2, V, 2, Q, 1, IW, RW, TAU, W,
     $                INFO )
         CALL CHKXER( 'ZGGSVP', INFOT, NOUT, LERR, OK )
         NT = NT + 11
*
*        ZTGSJA
*
         SRNAMT = 'ZTGSJA'
         INFOT = 1
         CALL ZTGSJA( '/', '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 20
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         INFOT = 22
         CALL ZTGSJA( '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( 'ZTGSJA', INFOT, NOUT, LERR, OK )
         NT = NT + 11
*
*     Test error exits for the GLM path.
*
      ELSE IF( LSAMEN( 3, PATH, 'GLM' ) ) THEN
*
*        ZGGGLM
*
         SRNAMT = 'ZGGGLM'
         INFOT = 1
         CALL ZGGGLM( -1, 0, 0, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZGGGLM( 0, -1, 0, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZGGGLM( 0, 1, 0, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGGLM( 0, 0, -1, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGGLM( 1, 0, 0, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZGGGLM( 0, 0, 0, A, 0, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL ZGGGLM( 0, 0, 0, A, 1, B, 0, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL ZGGGLM( 1, 1, 1, A, 1, B, 1, TAU, ALPHA, BETA, W, 1,
     $                INFO )
         CALL CHKXER( 'ZGGGLM', INFOT, NOUT, LERR, OK )
         NT = NT + 8
*
*     Test error exits for the LSE path.
*
      ELSE IF( LSAMEN( 3, PATH, 'LSE' ) ) THEN
*
*        ZGGLSE
*
         SRNAMT = 'ZGGLSE'
         INFOT = 1
         CALL ZGGLSE( -1, 0, 0, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZGGLSE( 0, -1, 0, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGLSE( 0, 0, -1, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGLSE( 0, 0, 1, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGLSE( 0, 1, 0, A, 1, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZGGLSE( 0, 0, 0, A, 0, B, 1, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL ZGGLSE( 0, 0, 0, A, 1, B, 0, TAU, ALPHA, BETA, W, LW,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL ZGGLSE( 1, 1, 1, A, 1, B, 1, TAU, ALPHA, BETA, W, 1,
     $                INFO )
         CALL CHKXER( 'ZGGLSE', INFOT, NOUT, LERR, OK )
         NT = NT + 8
*
*     Test error exits for the GQR path.
*
      ELSE IF( LSAMEN( 3, PATH, 'GQR' ) ) THEN
*
*        ZGGQRF
*
         SRNAMT = 'ZGGQRF'
         INFOT = 1
         CALL ZGGQRF( -1, 0, 0, A, 1, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZGGQRF( 0, -1, 0, A, 1, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGQRF( 0, 0, -1, A, 1, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZGGQRF( 0, 0, 0, A, 0, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZGGQRF( 0, 0, 0, A, 1, ALPHA, B, 0, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGQRF', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL ZGGQRF( 1, 1, 2, A, 1, ALPHA, B, 1, BETA, W, 1, INFO )
         CALL CHKXER( 'ZGGQRF', INFOT, NOUT, LERR, OK )
         NT = NT + 6
*
*        ZGGRQF
*
         SRNAMT = 'ZGGRQF'
         INFOT = 1
         CALL ZGGRQF( -1, 0, 0, A, 1, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZGGRQF( 0, -1, 0, A, 1, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGRQF( 0, 0, -1, A, 1, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZGGRQF( 0, 0, 0, A, 0, ALPHA, B, 1, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZGGRQF( 0, 0, 0, A, 1, ALPHA, B, 0, BETA, W, LW, INFO )
         CALL CHKXER( 'ZGGRQF', INFOT, NOUT, LERR, OK )
         INFOT = 11
         CALL ZGGRQF( 1, 1, 2, A, 1, ALPHA, B, 1, BETA, W, 1, INFO )
         CALL CHKXER( 'ZGGRQF', INFOT, NOUT, LERR, OK )
         NT = NT + 6
*
*     Test error exits for the ZGS, ZGV, ZGX, and ZXV paths.
*
      ELSE IF( LSAMEN( 3, PATH, 'ZGS' ) .OR.
     $         LSAMEN( 3, PATH, 'ZGV' ) .OR.
     $         LSAMEN( 3, PATH, 'ZGX' ) .OR. LSAMEN( 3, PATH, 'ZXV' ) )
     $          THEN
*
*        ZGGES
*
         SRNAMT = 'ZGGES '
         INFOT = 1
         CALL ZGGES( '/', 'N', 'S', ZLCTES, 1, A, 1, B, 1, SDIM, ALPHA,
     $               BETA, Q, 1, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZGGES( 'N', '/', 'S', ZLCTES, 1, A, 1, B, 1, SDIM, ALPHA,
     $               BETA, Q, 1, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGES( 'N', 'V', '/', ZLCTES, 1, A, 1, B, 1, SDIM, ALPHA,
     $               BETA, Q, 1, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZGGES( 'N', 'V', 'S', ZLCTES, -1, A, 1, B, 1, SDIM, ALPHA,
     $               BETA, Q, 1, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL ZGGES( 'N', 'V', 'S', ZLCTES, 1, A, 0, B, 1, SDIM, ALPHA,
     $               BETA, Q, 1, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 9
         CALL ZGGES( 'N', 'V', 'S', ZLCTES, 1, A, 1, B, 0, SDIM, ALPHA,
     $               BETA, Q, 1, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL ZGGES( 'N', 'V', 'S', ZLCTES, 1, A, 1, B, 1, SDIM, ALPHA,
     $               BETA, Q, 0, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 14
         CALL ZGGES( 'V', 'V', 'S', ZLCTES, 2, A, 2, B, 2, SDIM, ALPHA,
     $               BETA, Q, 1, U, 2, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL ZGGES( 'N', 'V', 'S', ZLCTES, 1, A, 1, B, 1, SDIM, ALPHA,
     $               BETA, Q, 1, U, 0, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 16
         CALL ZGGES( 'V', 'V', 'S', ZLCTES, 2, A, 2, B, 2, SDIM, ALPHA,
     $               BETA, Q, 2, U, 1, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         INFOT = 18
         CALL ZGGES( 'V', 'V', 'S', ZLCTES, 2, A, 2, B, 2, SDIM, ALPHA,
     $               BETA, Q, 2, U, 2, W, 1, RW, BW, INFO )
         CALL CHKXER( 'ZGGES ', INFOT, NOUT, LERR, OK )
         NT = NT + 11
*
*        ZGGESX
*
         SRNAMT = 'ZGGESX'
         INFOT = 1
         CALL ZGGESX( '/', 'N', 'S', ZLCTSX, 'N', 1, A, 1, B, 1, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZGGESX( 'N', '/', 'S', ZLCTSX, 'N', 1, A, 1, B, 1, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZGGESX( 'V', 'V', '/', ZLCTSX, 'N', 1, A, 1, B, 1, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, '/', 1, A, 1, B, 1, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', -1, A, 1, B, 1, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', 1, A, 0, B, 1, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', 1, A, 1, B, 0, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 15
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', 1, A, 1, B, 1, SDIM,
     $                ALPHA, BETA, Q, 0, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 15
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', 2, A, 2, B, 2, SDIM,
     $                ALPHA, BETA, Q, 1, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 17
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', 1, A, 1, B, 1, SDIM,
     $                ALPHA, BETA, Q, 1, U, 0, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 17
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', 2, A, 2, B, 2, SDIM,
     $                ALPHA, BETA, Q, 2, U, 1, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )
         INFOT = 21
         CALL ZGGESX( 'V', 'V', 'S', ZLCTSX, 'B', 2, A, 2, B, 2, SDIM,
     $                ALPHA, BETA, Q, 2, U, 2, RCE, RCV, W, 1, RW, IW,
     $                1, BW, INFO )
         CALL CHKXER( 'ZGGESX', INFOT, NOUT, LERR, OK )