LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cerrqp.f
Go to the documentation of this file.
00001 *> \brief \b CERRQP
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE CERRQP( PATH, NUNIT )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       CHARACTER*3        PATH
00015 *       INTEGER            NUNIT
00016 *       ..
00017 *  
00018 *
00019 *> \par Purpose:
00020 *  =============
00021 *>
00022 *> \verbatim
00023 *>
00024 *> CERRQP tests the error exits for CGEQPF and CGEQP3.
00025 *> \endverbatim
00026 *
00027 *  Arguments:
00028 *  ==========
00029 *
00030 *> \param[in] PATH
00031 *> \verbatim
00032 *>          PATH is CHARACTER*3
00033 *>          The LAPACK path name for the routines to be tested.
00034 *> \endverbatim
00035 *>
00036 *> \param[in] NUNIT
00037 *> \verbatim
00038 *>          NUNIT is INTEGER
00039 *>          The unit number for output.
00040 *> \endverbatim
00041 *
00042 *  Authors:
00043 *  ========
00044 *
00045 *> \author Univ. of Tennessee 
00046 *> \author Univ. of California Berkeley 
00047 *> \author Univ. of Colorado Denver 
00048 *> \author NAG Ltd. 
00049 *
00050 *> \date November 2011
00051 *
00052 *> \ingroup complex_lin
00053 *
00054 *  =====================================================================
00055       SUBROUTINE CERRQP( PATH, NUNIT )
00056 *
00057 *  -- LAPACK test routine (version 3.4.0) --
00058 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00059 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00060 *     November 2011
00061 *
00062 *     .. Scalar Arguments ..
00063       CHARACTER*3        PATH
00064       INTEGER            NUNIT
00065 *     ..
00066 *
00067 *  =====================================================================
00068 *
00069 *     .. Parameters ..
00070       INTEGER            NMAX
00071       PARAMETER          ( NMAX = 3 )
00072 *     ..
00073 *     .. Local Scalars ..
00074       CHARACTER*2        C2
00075       INTEGER            INFO, LW
00076 *     ..
00077 *     .. Local Arrays ..
00078       INTEGER            IP( NMAX )
00079       REAL               RW( 2*NMAX )
00080       COMPLEX            A( NMAX, NMAX ), TAU( NMAX ),
00081      $                   W( 2*NMAX+3*NMAX )
00082 *     ..
00083 *     .. External Functions ..
00084       LOGICAL            LSAMEN
00085       EXTERNAL           LSAMEN
00086 *     ..
00087 *     .. External Subroutines ..
00088       EXTERNAL           ALAESM, CGEQP3, CGEQPF, CHKXER
00089 *     ..
00090 *     .. Scalars in Common ..
00091       LOGICAL            LERR, OK
00092       CHARACTER*32       SRNAMT
00093       INTEGER            INFOT, NOUT
00094 *     ..
00095 *     .. Common blocks ..
00096       COMMON             / INFOC / INFOT, NOUT, OK, LERR
00097       COMMON             / SRNAMC / SRNAMT
00098 *     ..
00099 *     .. Intrinsic Functions ..
00100       INTRINSIC          CMPLX
00101 *     ..
00102 *     .. Executable Statements ..
00103 *
00104       NOUT = NUNIT
00105       C2 = PATH( 2: 3 )
00106       LW = NMAX + 1
00107       A( 1, 1 ) = CMPLX( 1.0E+0, -1.0E+0 )
00108       A( 1, 2 ) = CMPLX( 2.0E+0, -2.0E+0 )
00109       A( 2, 2 ) = CMPLX( 3.0E+0, -3.0E+0 )
00110       A( 2, 1 ) = CMPLX( 4.0E+0, -4.0E+0 )
00111       OK = .TRUE.
00112       WRITE( NOUT, FMT = * )
00113 *
00114 *     Test error exits for QR factorization with pivoting
00115 *
00116       IF( LSAMEN( 2, C2, 'QP' ) ) THEN
00117 *
00118 *        CGEQPF
00119 *
00120          SRNAMT = 'CGEQPF'
00121          INFOT = 1
00122          CALL CGEQPF( -1, 0, A, 1, IP, TAU, W, RW, INFO )
00123          CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
00124          INFOT = 2
00125          CALL CGEQPF( 0, -1, A, 1, IP, TAU, W, RW, INFO )
00126          CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
00127          INFOT = 4
00128          CALL CGEQPF( 2, 0, A, 1, IP, TAU, W, RW, INFO )
00129          CALL CHKXER( 'CGEQPF', INFOT, NOUT, LERR, OK )
00130 *
00131 *        CGEQP3
00132 *
00133          SRNAMT = 'CGEQP3'
00134          INFOT = 1
00135          CALL CGEQP3( -1, 0, A, 1, IP, TAU, W, LW, RW, INFO )
00136          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00137          INFOT = 2
00138          CALL CGEQP3( 1, -1, A, 1, IP, TAU, W, LW, RW, INFO )
00139          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00140          INFOT = 4
00141          CALL CGEQP3( 2, 3, A, 1, IP, TAU, W, LW, RW, INFO )
00142          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00143          INFOT = 8
00144          CALL CGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, RW, INFO )
00145          CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK )
00146       END IF
00147 *
00148 *     Print a summary line.
00149 *
00150       CALL ALAESM( PATH, OK, NOUT )
00151 *
00152       RETURN
00153 *
00154 *     End of CERRQP
00155 *
00156       END
 All Files Functions