zerrtr.f

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

         INFOT = 1
         CALL ZTPTRS( '/', 'N', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'ZTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZTPTRS( 'U', '/', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'ZTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZTPTRS( 'U', 'N', '/', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'ZTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZTPTRS( 'U', 'N', 'N', -1, 0, A, X, 1, INFO )
         CALL CHKXER( 'ZTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZTPTRS( 'U', 'N', 'N', 0, -1, A, X, 1, INFO )
         CALL CHKXER( 'ZTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZTPTRS( 'U', 'N', 'N', 2, 1, A, X, 1, INFO )
         CALL CHKXER( 'ZTPTRS', INFOT, NOUT, LERR, OK )
*
*        ZTPRFS
*
         SRNAMT = 'ZTPRFS'
         INFOT = 1
         CALL ZTPRFS( '/', 'N', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'ZTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZTPRFS( 'U', '/', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'ZTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZTPRFS( 'U', 'N', '/', 0, 0, A, B, 1, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'ZTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZTPRFS( 'U', 'N', 'N', -1, 0, A, B, 1, X, 1, R1, R2, W,
     $                RW, INFO )
         CALL CHKXER( 'ZTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZTPRFS( 'U', 'N', 'N', 0, -1, A, B, 1, X, 1, R1, R2, W,
     $                RW, INFO )
         CALL CHKXER( 'ZTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZTPRFS( 'U', 'N', 'N', 2, 1, A, B, 1, X, 2, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'ZTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL ZTPRFS( 'U', 'N', 'N', 2, 1, A, B, 2, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'ZTPRFS', INFOT, NOUT, LERR, OK )
*
*        ZTPCON
*
         SRNAMT = 'ZTPCON'
         INFOT = 1
         CALL ZTPCON( '/', 'U', 'N', 0, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZTPCON( '1', '/', 'N', 0, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZTPCON( '1', 'U', '/', 0, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZTPCON( '1', 'U', 'N', -1, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTPCON', INFOT, NOUT, LERR, OK )
*
*        ZLATPS
*
         SRNAMT = 'ZLATPS'
         INFOT = 1
         CALL ZLATPS( '/', 'N', 'N', 'N', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'ZLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZLATPS( 'U', '/', 'N', 'N', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'ZLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZLATPS( 'U', 'N', '/', 'N', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'ZLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZLATPS( 'U', 'N', 'N', '/', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'ZLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZLATPS( 'U', 'N', 'N', 'N', -1, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'ZLATPS', INFOT, NOUT, LERR, OK )
*
*     Test error exits for the banded triangular routines.
*
      ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
*
*        ZTBTRS
*
         SRNAMT = 'ZTBTRS'
         INFOT = 1
         CALL ZTBTRS( '/', 'N', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZTBTRS( 'U', '/', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZTBTRS( 'U', 'N', '/', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZTBTRS( 'U', 'N', 'N', -1, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZTBTRS( 'U', 'N', 'N', 0, -1, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL ZTBTRS( 'U', 'N', 'N', 0, 0, -1, A, 1, X, 1, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZTBTRS( 'U', 'N', 'N', 2, 1, 1, A, 1, X, 2, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL ZTBTRS( 'U', 'N', 'N', 2, 0, 1, A, 1, X, 1, INFO )
         CALL CHKXER( 'ZTBTRS', INFOT, NOUT, LERR, OK )
*
*        ZTBRFS
*
         SRNAMT = 'ZTBRFS'
         INFOT = 1
         CALL ZTBRFS( '/', 'N', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZTBRFS( 'U', '/', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZTBRFS( 'U', 'N', '/', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZTBRFS( 'U', 'N', 'N', -1, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZTBRFS( 'U', 'N', 'N', 0, -1, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL ZTBRFS( 'U', 'N', 'N', 0, 0, -1, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 1, B, 2, X, 2, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL ZTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 1, X, 2, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL ZTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 2, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'ZTBRFS', INFOT, NOUT, LERR, OK )
*
*        ZTBCON
*
         SRNAMT = 'ZTBCON'
         INFOT = 1
         CALL ZTBCON( '/', 'U', 'N', 0, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZTBCON( '1', '/', 'N', 0, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZTBCON( '1', 'U', '/', 0, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZTBCON( '1', 'U', 'N', -1, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZTBCON( '1', 'U', 'N', 0, -1, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL ZTBCON( '1', 'U', 'N', 2, 1, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'ZTBCON', INFOT, NOUT, LERR, OK )
*
*        ZLATBS
*
         SRNAMT = 'ZLATBS'
         INFOT = 1
         CALL ZLATBS( '/', 'N', 'N', 'N', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'ZLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL ZLATBS( 'U', '/', 'N', 'N', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'ZLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL ZLATBS( 'U', 'N', '/', 'N', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'ZLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL ZLATBS( 'U', 'N', 'N', '/', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'ZLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL ZLATBS( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'ZLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL ZLATBS( 'U', 'N', 'N', 'N', 1, -1, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'ZLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL ZLATBS( 'U', 'N', 'N', 'N', 2, 1, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'ZLATBS', INFOT, NOUT, LERR, OK )
      END IF
*
*     Print a summary line.
*
      CALL ALAESM( PATH, OK, NOUT )
*
      RETURN
*
*     End of ZERRTR
*
      END