serrtr.f

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

*        STPTRS
*
         SRNAMT = 'STPTRS'
         INFOT = 1
         CALL STPTRS( '/', 'N', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'STPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STPTRS( 'U', '/', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'STPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STPTRS( 'U', 'N', '/', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'STPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STPTRS( 'U', 'N', 'N', -1, 0, A, X, 1, INFO )
         CALL CHKXER( 'STPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STPTRS( 'U', 'N', 'N', 0, -1, A, X, 1, INFO )
         CALL CHKXER( 'STPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL STPTRS( 'U', 'N', 'N', 2, 1, A, X, 1, INFO )
         CALL CHKXER( 'STPTRS', INFOT, NOUT, LERR, OK )
*
*        STPRFS
*
         SRNAMT = 'STPRFS'
         INFOT = 1
         CALL STPRFS( '/', 'N', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'STPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STPRFS( 'U', '/', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'STPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STPRFS( 'U', 'N', '/', 0, 0, A, B, 1, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'STPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STPRFS( 'U', 'N', 'N', -1, 0, A, B, 1, X, 1, R1, R2, W,
     $                IW, INFO )
         CALL CHKXER( 'STPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STPRFS( 'U', 'N', 'N', 0, -1, A, B, 1, X, 1, R1, R2, W,
     $                IW, INFO )
         CALL CHKXER( 'STPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL STPRFS( 'U', 'N', 'N', 2, 1, A, B, 1, X, 2, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'STPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL STPRFS( 'U', 'N', 'N', 2, 1, A, B, 2, X, 1, R1, R2, W, IW,
     $                INFO )
         CALL CHKXER( 'STPRFS', INFOT, NOUT, LERR, OK )
*
*        STPCON
*
         SRNAMT = 'STPCON'
         INFOT = 1
         CALL STPCON( '/', 'U', 'N', 0, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'STPCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STPCON( '1', '/', 'N', 0, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'STPCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STPCON( '1', 'U', '/', 0, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'STPCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STPCON( '1', 'U', 'N', -1, A, RCOND, W, IW, INFO )
         CALL CHKXER( 'STPCON', INFOT, NOUT, LERR, OK )
*
*        SLATPS
*
         SRNAMT = 'SLATPS'
         INFOT = 1
         CALL SLATPS( '/', 'N', 'N', 'N', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'SLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SLATPS( 'U', '/', 'N', 'N', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'SLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SLATPS( 'U', 'N', '/', 'N', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'SLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL SLATPS( 'U', 'N', 'N', '/', 0, A, X, SCALE, W, INFO )
         CALL CHKXER( 'SLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SLATPS( 'U', 'N', 'N', 'N', -1, A, X, SCALE, W, INFO )
         CALL CHKXER( 'SLATPS', INFOT, NOUT, LERR, OK )
*
      ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
*
*        Test error exits for the banded triangular routines.
*
*        STBTRS
*
         SRNAMT = 'STBTRS'
         INFOT = 1
         CALL STBTRS( '/', 'N', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STBTRS( 'U', '/', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STBTRS( 'U', 'N', '/', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STBTRS( 'U', 'N', 'N', -1, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STBTRS( 'U', 'N', 'N', 0, -1, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL STBTRS( 'U', 'N', 'N', 0, 0, -1, A, 1, X, 1, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL STBTRS( 'U', 'N', 'N', 2, 1, 1, A, 1, X, 2, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL STBTRS( 'U', 'N', 'N', 2, 0, 1, A, 1, X, 1, INFO )
         CALL CHKXER( 'STBTRS', INFOT, NOUT, LERR, OK )
*
*        STBRFS
*
         SRNAMT = 'STBRFS'
         INFOT = 1
         CALL STBRFS( '/', 'N', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STBRFS( 'U', '/', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STBRFS( 'U', 'N', '/', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STBRFS( 'U', 'N', 'N', -1, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STBRFS( 'U', 'N', 'N', 0, -1, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL STBRFS( 'U', 'N', 'N', 0, 0, -1, A, 1, B, 1, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL STBRFS( 'U', 'N', 'N', 2, 1, 1, A, 1, B, 2, X, 2, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL STBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 1, X, 2, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL STBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 2, X, 1, R1, R2,
     $                W, IW, INFO )
         CALL CHKXER( 'STBRFS', INFOT, NOUT, LERR, OK )
*
*        STBCON
*
         SRNAMT = 'STBCON'
         INFOT = 1
         CALL STBCON( '/', 'U', 'N', 0, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'STBCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL STBCON( '1', '/', 'N', 0, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'STBCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL STBCON( '1', 'U', '/', 0, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'STBCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL STBCON( '1', 'U', 'N', -1, 0, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'STBCON', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL STBCON( '1', 'U', 'N', 0, -1, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'STBCON', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL STBCON( '1', 'U', 'N', 2, 1, A, 1, RCOND, W, IW, INFO )
         CALL CHKXER( 'STBCON', INFOT, NOUT, LERR, OK )
*
*        SLATBS
*
         SRNAMT = 'SLATBS'
         INFOT = 1
         CALL SLATBS( '/', 'N', 'N', 'N', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'SLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL SLATBS( 'U', '/', 'N', 'N', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'SLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL SLATBS( 'U', 'N', '/', 'N', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'SLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL SLATBS( 'U', 'N', 'N', '/', 0, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'SLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL SLATBS( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'SLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL SLATBS( 'U', 'N', 'N', 'N', 1, -1, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'SLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL SLATBS( 'U', 'N', 'N', 'N', 2, 1, A, 1, X, SCALE, W,
     $                INFO )
         CALL CHKXER( 'SLATBS', INFOT, NOUT, LERR, OK )
      END IF
*
*     Print a summary line.
*
      CALL ALAESM( PATH, OK, NOUT )
*
      RETURN
*
*     End of SERRTR
*
      END