d9/d43/serrqp_8f_source.html

00001       SUBROUTINE SERRQP( PATH, NUNIT )
00002 *
00003 *  -- LAPACK test routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       CHARACTER*3        PATH
00009       INTEGER            NUNIT
00010 *     ..
00011 *
00012 *  Purpose
00013 *  =======
00014 *
00015 *  SERRQP tests the error exits for SGEQPF and SGEQP3.
00016 *
00017 *  Arguments
00018 *  =========
00019 *
00020 *  PATH    (input) CHARACTER*3
00021 *          The LAPACK path name for the routines to be tested.
00022 *
00023 *  NUNIT   (input) INTEGER
00024 *          The unit number for output.
00025 *
00026 *  =====================================================================
00027 *
00028 *     .. Parameters ..
00029       INTEGER            NMAX
00030       PARAMETER          ( NMAX = 3 )
00031 *     ..
00032 *     .. Local Scalars ..
00033       CHARACTER*2        C2
00034       INTEGER            INFO, LW
00035 *     ..
00036 *     .. Local Arrays ..
00037       INTEGER            IP( NMAX )
00038       REAL               A( NMAX, NMAX ), TAU( NMAX ), W( 3*NMAX+1 )
00039 *     ..
00040 *     .. External Functions ..
00041       LOGICAL            LSAMEN
00042       EXTERNAL           LSAMEN
00043 *     ..
00044 *     .. External Subroutines ..
00045       EXTERNAL           ALAESM, CHKXER, SGEQP3, SGEQPF
00046 *     ..
00047 *     .. Scalars in Common ..
00048       LOGICAL            LERR, OK
00049       CHARACTER*32       SRNAMT
00050       INTEGER            INFOT, NOUT
00051 *     ..
00052 *     .. Common blocks ..
00053       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00054       COMMON             / SRNAMC / SRNAMT
00055 *     ..
00056 *     .. Executable Statements ..
00057 *
00058       NOUT = NUNIT
00059       WRITE( NOUT, FMT = * )
00060       C2 = PATH( 2: 3 )
00061       LW = 3*NMAX + 1
00062       A( 1, 1 ) = 1.0E+0
00063       A( 1, 2 ) = 2.0E+0
00064       A( 2, 2 ) = 3.0E+0
00065       A( 2, 1 ) = 4.0E+0
00066       OK = .TRUE.
00067 *
00068       IF( LSAMEN( 2, C2, 'QP' ) ) THEN
00069 *
00070 *        Test error exits for QR factorization with pivoting
00071 *
00072 *        SGEQPF
00073 *
00074          SRNAMT = 'SGEQPF'
00075          INFOT = 1
00076          CALL SGEQPF( -1, 0, A, 1, IP, TAU, W, INFO )
00077          CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
00078          INFOT = 2
00079          CALL SGEQPF( 0, -1, A, 1, IP, TAU, W, INFO )
00080          CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
00081          INFOT = 4
00082          CALL SGEQPF( 2, 0, A, 1, IP, TAU, W, INFO )
00083          CALL CHKXER( 'SGEQPF', INFOT, NOUT, LERR, OK )
00084 *
00085 *        SGEQP3
00086 *
00087          SRNAMT = 'SGEQP3'
00088          INFOT = 1
00089          CALL SGEQP3( -1, 0, A, 1, IP, TAU, W, LW, INFO )
00090          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00091          INFOT = 2
00092          CALL SGEQP3( 1, -1, A, 1, IP, TAU, W, LW, INFO )
00093          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00094          INFOT = 4
00095          CALL SGEQP3( 2, 3, A, 1, IP, TAU, W, LW, INFO )
00096          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00097          INFOT = 8
00098          CALL SGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, INFO )
00099          CALL CHKXER( 'SGEQP3', INFOT, NOUT, LERR, OK )
00100       END IF
00101 *
00102 *     Print a summary line.
00103 *
00104       CALL ALAESM( PATH, OK, NOUT )
00105 *
00106       RETURN
00107 *
00108 *     End of SERRQP
00109 *
00110       END