derrtr.f

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

*        DTPTRS
*
         SRNAMT = 'DTPTRS'
         INFOT = 1
         CALL DTPTRS( '/', 'N', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'DTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DTPTRS( 'U', '/', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'DTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DTPTRS( 'U', 'N', '/', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'DTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DTPTRS( 'U', 'N', 'N', -1, 0, A, X, 1, INFO )
         CALL CHKXER( 'DTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL DTPTRS( 'U', 'N', 'N', 0, -1, A, X, 1, INFO )
         CALL CHKXER( 'DTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL DTPTRS( 'U', 'N', 'N', 2, 1, A, X, 1, INFO )
         CALL CHKXER( 'DTPTRS', INFOT, NOUT, LERR, OK )
*
*        DTPRFS
*
         SRNAMT = 'DTPRFS'
         INFOT = 1
         CALL DTPRFS( '/', 'N', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'DTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DTPRFS( 'U', '/', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'DTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DTPRFS( 'U', 'N', '/', 0, 0, A, B, 1, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'DTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DTPRFS( 'U', 'N', 'N', -1, 0, A, B, 1, X, 1, R1, R2, W,
     $                IW, INFO )
         CALL CHKXER( 'DTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL DTPRFS( 'U', 'N', 'N', 0, -1, A, B, 1, X, 1, R1, R2, W,
     $                IW, INFO )
         CALL CHKXER( 'DTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL DTPRFS( 'U', 'N', 'N', 2, 1, A, B, 1, X, 2, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'DTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL DTPRFS( 'U', 'N', 'N', 2, 1, A, B, 2, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'DTPRFS', INFOT, NOUT, LERR, OK )
*
*        DTPCON
*
         SRNAMT = 'DTPCON'
         INFOT = 1
         CALL DTPCON( '/', 'U', 'N', 0, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DTPCON( '1', '/', 'N', 0, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DTPCON( '1', 'U', '/', 0, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DTPCON( '1', 'U', 'N', -1, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTPCON', INFOT, NOUT, LERR, OK )
*
*        DLATPS
*
         SRNAMT = 'DLATPS'
         INFOT = 1
         CALL DLATPS( '/', 'N', 'N', 'N', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'DLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DLATPS( 'U', '/', 'N', 'N', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'DLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DLATPS( 'U', 'N', '/', 'N', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'DLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DLATPS( 'U', 'N', 'N', '/', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'DLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL DLATPS( 'U', 'N', 'N', 'N', -1, A, X, SCALE, W, INFO )
         CALL CHKXER( 'DLATPS', INFOT, NOUT, LERR, OK )
*
      ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
*
*        Test error exits for the banded triangular routines.
*
*        DTBTRS
*
         SRNAMT = 'DTBTRS'
         INFOT = 1
         CALL DTBTRS( '/', 'N', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DTBTRS( 'U', '/', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DTBTRS( 'U', 'N', '/', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DTBTRS( 'U', 'N', 'N', -1, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL DTBTRS( 'U', 'N', 'N', 0, -1, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL DTBTRS( 'U', 'N', 'N', 0, 0, -1, A, 1, X, 1, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL DTBTRS( 'U', 'N', 'N', 2, 1, 1, A, 1, X, 2, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL DTBTRS( 'U', 'N', 'N', 2, 0, 1, A, 1, X, 1, INFO )
         CALL CHKXER( 'DTBTRS', INFOT, NOUT, LERR, OK )
*
*        DTBRFS
*
         SRNAMT = 'DTBRFS'
         INFOT = 1
         CALL DTBRFS( '/', 'N', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DTBRFS( 'U', '/', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DTBRFS( 'U', 'N', '/', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DTBRFS( 'U', 'N', 'N', -1, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL DTBRFS( 'U', 'N', 'N', 0, -1, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL DTBRFS( 'U', 'N', 'N', 0, 0, -1, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL DTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 1, B, 2, X, 2, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL DTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 1, X, 2, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL DTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 2, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'DTBRFS', INFOT, NOUT, LERR, OK )
*
*        DTBCON
*
         SRNAMT = 'DTBCON'
         INFOT = 1
         CALL DTBCON( '/', 'U', 'N', 0, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DTBCON( '1', '/', 'N', 0, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DTBCON( '1', 'U', '/', 0, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DTBCON( '1', 'U', 'N', -1, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL DTBCON( '1', 'U', 'N', 0, -1, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL DTBCON( '1', 'U', 'N', 2, 1, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'DTBCON', INFOT, NOUT, LERR, OK )
*
*        DLATBS
*
         SRNAMT = 'DLATBS'
         INFOT = 1
         CALL DLATBS( '/', 'N', 'N', 'N', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'DLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL DLATBS( 'U', '/', 'N', 'N', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'DLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL DLATBS( 'U', 'N', '/', 'N', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'DLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL DLATBS( 'U', 'N', 'N', '/', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'DLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL DLATBS( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'DLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL DLATBS( 'U', 'N', 'N', 'N', 1, -1, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'DLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL DLATBS( 'U', 'N', 'N', 'N', 2, 1, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'DLATBS', INFOT, NOUT, LERR, OK )
      END IF
*
*     Print a summary line.
*
      CALL ALAESM( PATH, OK, NOUT )
*
      RETURN
*
*     End of DERRTR
*
      END