d0/d5a/cerrqp_8f_source.html

00001       SUBROUTINE CERRQP( 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 *  CERRQP tests the error exits for CGEQPF and CGEQP3.
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               RW( 2*NMAX )
00039       COMPLEX            A( NMAX, NMAX ), TAU( NMAX ),
00040      $                   W( 2*NMAX+3*NMAX )
00041 *     ..
00042 *     .. External Functions ..
00043       LOGICAL            LSAMEN
00044       EXTERNAL           LSAMEN
00045 *     ..
00046 *     .. External Subroutines ..
00047       EXTERNAL           ALAESM, CGEQP3, CGEQPF, CHKXER
00048 *     ..
00049 *     .. Scalars in Common ..
00050       LOGICAL            LERR, OK
00051       CHARACTER*32       SRNAMT
00052       INTEGER            INFOT, NOUT
00053 *     ..
00054 *     .. Common blocks ..
00055       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00056       COMMON             / SRNAMC / SRNAMT
00057 *     ..
00058 *     .. Intrinsic Functions ..
00059       INTRINSIC          CMPLX
00060 *     ..
00061 *     .. Executable Statements ..
00062 *
00063       NOUT = NUNIT
00064       C2 = PATH( 2: 3 )
00065       LW = NMAX + 1
00066       A( 1, 1 ) = CMPLX( 1.0E+0, -1.0E+0 )
00067       A( 1, 2 ) = CMPLX( 2.0E+0, -2.0E+0 )
00068       A( 2, 2 ) = CMPLX( 3.0E+0, -3.0E+0 )
00069       A( 2, 1 ) = CMPLX( 4.0E+0, -4.0E+0 )
00070       OK = .TRUE.
00071       WRITE( NOUT, FMT = * )
00072 *
00073 *     Test error exits for QR factorization with pivoting
00074 *
00075       IF( LSAMEN( 2, C2, 'QP' ) ) THEN
00076 *
00077 *        CGEQPF
00078 *
00079          SRNAMT = 'CGEQPF'
00080          INFOT = 1
00081          CALL CGEQPF( -1, 0, A, 1, IP, TAU, W, RW, INFO )
00082          CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
00083          INFOT = 2
00084          CALL CGEQPF( 0, -1, A, 1, IP, TAU, W, RW, INFO )
00085          CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
00086          INFOT = 4
00087          CALL CGEQPF( 2, 0, A, 1, IP, TAU, W, RW, INFO )
00088          CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
00089 *
00090 *        CGEQP3
00091 *
00092          SRNAMT = 'CGEQP3'
00093          INFOT = 1
00094          CALL CGEQP3( -1, 0, A, 1, IP, TAU, W, LW, RW, INFO )
00095          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00096          INFOT = 2
00097          CALL CGEQP3( 1, -1, A, 1, IP, TAU, W, LW, RW, INFO )
00098          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00099          INFOT = 4
00100          CALL CGEQP3( 2, 3, A, 1, IP, TAU, W, LW, RW, INFO )
00101          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00102          INFOT = 8
00103          CALL CGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, RW, INFO )
00104          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00105       END IF
00106 *
00107 *     Print a summary line.
00108 *
00109       CALL ALAESM( PATH, OK, NOUT )
00110 *
00111       RETURN
00112 *
00113 *     End of CERRQP
00114 *
00115       END