1*> \brief \b CERRQP 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE CERRQP( PATH, NUNIT ) 12* 13* .. Scalar Arguments .. 14* CHARACTER*3 PATH 15* INTEGER NUNIT 16* .. 17* 18* 19*> \par Purpose: 20* ============= 21*> 22*> \verbatim 23*> 24*> CERRQP tests the error exits for CGEQP3. 25*> \endverbatim 26* 27* Arguments: 28* ========== 29* 30*> \param[in] PATH 31*> \verbatim 32*> PATH is CHARACTER*3 33*> The LAPACK path name for the routines to be tested. 34*> \endverbatim 35*> 36*> \param[in] NUNIT 37*> \verbatim 38*> NUNIT is INTEGER 39*> The unit number for output. 40*> \endverbatim 41* 42* Authors: 43* ======== 44* 45*> \author Univ. of Tennessee 46*> \author Univ. of California Berkeley 47*> \author Univ. of Colorado Denver 48*> \author NAG Ltd. 49* 50*> \date December 2016 51* 52*> \ingroup complex_lin 53* 54* ===================================================================== 55 SUBROUTINE CERRQP( PATH, NUNIT ) 56* 57* -- LAPACK test routine (version 3.7.0) -- 58* -- LAPACK is a software package provided by Univ. of Tennessee, -- 59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 60* December 2016 61* 62* .. Scalar Arguments .. 63 CHARACTER*3 PATH 64 INTEGER NUNIT 65* .. 66* 67* ===================================================================== 68* 69* .. Parameters .. 70 INTEGER NMAX 71 PARAMETER ( NMAX = 3 ) 72* .. 73* .. Local Scalars .. 74 CHARACTER*2 C2 75 INTEGER INFO, LW 76* .. 77* .. Local Arrays .. 78 INTEGER IP( NMAX ) 79 REAL RW( 2*NMAX ) 80 COMPLEX A( NMAX, NMAX ), TAU( NMAX ), 81 $ W( 2*NMAX+3*NMAX ) 82* .. 83* .. External Functions .. 84 LOGICAL LSAMEN 85 EXTERNAL LSAMEN 86* .. 87* .. External Subroutines .. 88 EXTERNAL ALAESM, CGEQP3, CHKXER 89* .. 90* .. Scalars in Common .. 91 LOGICAL LERR, OK 92 CHARACTER*32 SRNAMT 93 INTEGER INFOT, NOUT 94* .. 95* .. Common blocks .. 96 COMMON / INFOC / INFOT, NOUT, OK, LERR 97 COMMON / SRNAMC / SRNAMT 98* .. 99* .. Intrinsic Functions .. 100 INTRINSIC CMPLX 101* .. 102* .. Executable Statements .. 103* 104 NOUT = NUNIT 105 C2 = PATH( 2: 3 ) 106 LW = NMAX + 1 107 A( 1, 1 ) = CMPLX( 1.0E+0, -1.0E+0 ) 108 A( 1, 2 ) = CMPLX( 2.0E+0, -2.0E+0 ) 109 A( 2, 2 ) = CMPLX( 3.0E+0, -3.0E+0 ) 110 A( 2, 1 ) = CMPLX( 4.0E+0, -4.0E+0 ) 111 OK = .TRUE. 112 WRITE( NOUT, FMT = * ) 113* 114* Test error exits for QR factorization with pivoting 115* 116 IF( LSAMEN( 2, C2, 'QP' ) ) THEN 117* 118* CGEQP3 119* 120 SRNAMT = 'CGEQP3' 121 INFOT = 1 122 CALL CGEQP3( -1, 0, A, 1, IP, TAU, W, LW, RW, INFO ) 123 CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK ) 124 INFOT = 2 125 CALL CGEQP3( 1, -1, A, 1, IP, TAU, W, LW, RW, INFO ) 126 CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK ) 127 INFOT = 4 128 CALL CGEQP3( 2, 3, A, 1, IP, TAU, W, LW, RW, INFO ) 129 CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK ) 130 INFOT = 8 131 CALL CGEQP3( 2, 2, A, 2, IP, TAU, W, LW-10, RW, INFO ) 132 CALL CHKXER( 'CGEQP3', INFOT, NOUT, LERR, OK ) 133 END IF 134* 135* Print a summary line. 136* 137 CALL ALAESM( PATH, OK, NOUT ) 138* 139 RETURN 140* 141* End of CERRQP 142* 143 END 144