cerrtr.f

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

         INFOT = 1
         CALL CTPTRS( '/', 'N', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CTPTRS( 'U', '/', 'N', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CTPTRS( 'U', 'N', '/', 0, 0, A, X, 1, INFO )
         CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CTPTRS( 'U', 'N', 'N', -1, 0, A, X, 1, INFO )
         CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CTPTRS( 'U', 'N', 'N', 0, -1, A, X, 1, INFO )
         CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CTPTRS( 'U', 'N', 'N', 2, 1, A, X, 1, INFO )
         CALL CHKXER( 'CTPTRS', INFOT, NOUT, LERR, OK )
*
*        CTPRFS
*
         SRNAMT = 'CTPRFS'
         INFOT = 1
         CALL CTPRFS( '/', 'N', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CTPRFS( 'U', '/', 'N', 0, 0, A, B, 1, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CTPRFS( 'U', 'N', '/', 0, 0, A, B, 1, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CTPRFS( 'U', 'N', 'N', -1, 0, A, B, 1, X, 1, R1, R2, W,
     $                RW, INFO )
         CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CTPRFS( 'U', 'N', 'N', 0, -1, A, B, 1, X, 1, R1, R2, W,
     $                RW, INFO )
         CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CTPRFS( 'U', 'N', 'N', 2, 1, A, B, 1, X, 2, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL CTPRFS( 'U', 'N', 'N', 2, 1, A, B, 2, X, 1, R1, R2, W, RW,
     $                INFO )
         CALL CHKXER( 'CTPRFS', INFOT, NOUT, LERR, OK )
*
*        CTPCON
*
         SRNAMT = 'CTPCON'
         INFOT = 1
         CALL CTPCON( '/', 'U', 'N', 0, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CTPCON( '1', '/', 'N', 0, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CTPCON( '1', 'U', '/', 0, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CTPCON( '1', 'U', 'N', -1, A, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTPCON', INFOT, NOUT, LERR, OK )
*
*        CLATPS
*
         SRNAMT = 'CLATPS'
         INFOT = 1
         CALL CLATPS( '/', 'N', 'N', 'N', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CLATPS( 'U', '/', 'N', 'N', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CLATPS( 'U', 'N', '/', 'N', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CLATPS( 'U', 'N', 'N', '/', 0, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CLATPS( 'U', 'N', 'N', 'N', -1, A, X, SCALE, RW, INFO )
         CALL CHKXER( 'CLATPS', INFOT, NOUT, LERR, OK )
*
*     Test error exits for the banded triangular routines.
*
      ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN
*
*        CTBTRS
*
         SRNAMT = 'CTBTRS'
         INFOT = 1
         CALL CTBTRS( '/', 'N', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CTBTRS( 'U', '/', 'N', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CTBTRS( 'U', 'N', '/', 0, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CTBTRS( 'U', 'N', 'N', -1, 0, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CTBTRS( 'U', 'N', 'N', 0, -1, 0, A, 1, X, 1, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL CTBTRS( 'U', 'N', 'N', 0, 0, -1, A, 1, X, 1, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CTBTRS( 'U', 'N', 'N', 2, 1, 1, A, 1, X, 2, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL CTBTRS( 'U', 'N', 'N', 2, 0, 1, A, 1, X, 1, INFO )
         CALL CHKXER( 'CTBTRS', INFOT, NOUT, LERR, OK )
*
*        CTBRFS
*
         SRNAMT = 'CTBRFS'
         INFOT = 1
         CALL CTBRFS( '/', 'N', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CTBRFS( 'U', '/', 'N', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CTBRFS( 'U', 'N', '/', 0, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CTBRFS( 'U', 'N', 'N', -1, 0, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CTBRFS( 'U', 'N', 'N', 0, -1, 0, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL CTBRFS( 'U', 'N', 'N', 0, 0, -1, A, 1, B, 1, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 1, B, 2, X, 2, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 10
         CALL CTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 1, X, 2, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
         INFOT = 12
         CALL CTBRFS( 'U', 'N', 'N', 2, 1, 1, A, 2, B, 2, X, 1, R1, R2,
     $                W, RW, INFO )
         CALL CHKXER( 'CTBRFS', INFOT, NOUT, LERR, OK )
*
*        CTBCON
*
         SRNAMT = 'CTBCON'
         INFOT = 1
         CALL CTBCON( '/', 'U', 'N', 0, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CTBCON( '1', '/', 'N', 0, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CTBCON( '1', 'U', '/', 0, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CTBCON( '1', 'U', 'N', -1, 0, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CTBCON( '1', 'U', 'N', 0, -1, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
         INFOT = 7
         CALL CTBCON( '1', 'U', 'N', 2, 1, A, 1, RCOND, W, RW, INFO )
         CALL CHKXER( 'CTBCON', INFOT, NOUT, LERR, OK )
*
*        CLATBS
*
         SRNAMT = 'CLATBS'
         INFOT = 1
         CALL CLATBS( '/', 'N', 'N', 'N', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 2
         CALL CLATBS( 'U', '/', 'N', 'N', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 3
         CALL CLATBS( 'U', 'N', '/', 'N', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 4
         CALL CLATBS( 'U', 'N', 'N', '/', 0, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 5
         CALL CLATBS( 'U', 'N', 'N', 'N', -1, 0, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 6
         CALL CLATBS( 'U', 'N', 'N', 'N', 1, -1, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
         INFOT = 8
         CALL CLATBS( 'U', 'N', 'N', 'N', 2, 1, A, 1, X, SCALE, RW,
     $                INFO )
         CALL CHKXER( 'CLATBS', INFOT, NOUT, LERR, OK )
      END IF
*
*     Print a summary line.
*
      CALL ALAESM( PATH, OK, NOUT )
*
      RETURN
*
*     End of CERRTR
*
      END