1*> \brief \b CERRLQT 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 CERRLQT( 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*> CERRLQT tests the error exits for the COMPLEX routines 25*> that use the LQT decomposition of a general matrix. 26*> \endverbatim 27* 28* Arguments: 29* ========== 30* 31*> \param[in] PATH 32*> \verbatim 33*> PATH is CHARACTER*3 34*> The LAPACK path name for the routines to be tested. 35*> \endverbatim 36*> 37*> \param[in] NUNIT 38*> \verbatim 39*> NUNIT is INTEGER 40*> The unit number for output. 41*> \endverbatim 42* 43* Authors: 44* ======== 45* 46*> \author Univ. of Tennessee 47*> \author Univ. of California Berkeley 48*> \author Univ. of Colorado Denver 49*> \author NAG Ltd. 50* 51*> \ingroup double_lin 52* 53* ===================================================================== 54 SUBROUTINE CERRLQT( PATH, NUNIT ) 55 IMPLICIT NONE 56* 57* -- LAPACK test routine -- 58* -- LAPACK is a software package provided by Univ. of Tennessee, -- 59* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 60* 61* .. Scalar Arguments .. 62 CHARACTER*3 PATH 63 INTEGER NUNIT 64* .. 65* 66* ===================================================================== 67* 68* .. Parameters .. 69 INTEGER NMAX 70 PARAMETER ( NMAX = 2 ) 71* .. 72* .. Local Scalars .. 73 INTEGER I, INFO, J 74* .. 75* .. Local Arrays .. 76 COMPLEX A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 77 $ C( NMAX, NMAX ) 78* .. 79* .. External Subroutines .. 80 EXTERNAL ALAESM, CHKXER, CGELQT3, CGELQT, 81 $ CGEMLQT 82* .. 83* .. Scalars in Common .. 84 LOGICAL LERR, OK 85 CHARACTER*32 SRNAMT 86 INTEGER INFOT, NOUT 87* .. 88* .. Common blocks .. 89 COMMON / INFOC / INFOT, NOUT, OK, LERR 90 COMMON / SRNAMC / SRNAMT 91* .. 92* .. Intrinsic Functions .. 93 INTRINSIC REAL, CMPLX 94* .. 95* .. Executable Statements .. 96* 97 NOUT = NUNIT 98 WRITE( NOUT, FMT = * ) 99* 100* Set the variables to innocuous values. 101* 102 DO J = 1, NMAX 103 DO I = 1, NMAX 104 A( I, J ) = 1.E0 / CMPLX( REAL( I+J ), 0.E0 ) 105 C( I, J ) = 1.E0 / CMPLX( REAL( I+J ), 0.E0 ) 106 T( I, J ) = 1.E0 / CMPLX( REAL( I+J ), 0.E0 ) 107 END DO 108 W( J ) = 0.E0 109 END DO 110 OK = .TRUE. 111* 112* Error exits for LQT factorization 113* 114* CGELQT 115* 116 SRNAMT = 'CGELQT' 117 INFOT = 1 118 CALL CGELQT( -1, 0, 1, A, 1, T, 1, W, INFO ) 119 CALL CHKXER( 'CGELQT', INFOT, NOUT, LERR, OK ) 120 INFOT = 2 121 CALL CGELQT( 0, -1, 1, A, 1, T, 1, W, INFO ) 122 CALL CHKXER( 'CGELQT', INFOT, NOUT, LERR, OK ) 123 INFOT = 3 124 CALL CGELQT( 0, 0, 0, A, 1, T, 1, W, INFO ) 125 CALL CHKXER( 'CGELQT', INFOT, NOUT, LERR, OK ) 126 INFOT = 5 127 CALL CGELQT( 2, 1, 1, A, 1, T, 1, W, INFO ) 128 CALL CHKXER( 'CGELQT', INFOT, NOUT, LERR, OK ) 129 INFOT = 7 130 CALL CGELQT( 2, 2, 2, A, 2, T, 1, W, INFO ) 131 CALL CHKXER( 'CGELQT', INFOT, NOUT, LERR, OK ) 132* 133* CGELQT3 134* 135 SRNAMT = 'CGELQT3' 136 INFOT = 1 137 CALL CGELQT3( -1, 0, A, 1, T, 1, INFO ) 138 CALL CHKXER( 'CGELQT3', INFOT, NOUT, LERR, OK ) 139 INFOT = 2 140 CALL CGELQT3( 0, -1, A, 1, T, 1, INFO ) 141 CALL CHKXER( 'CGELQT3', INFOT, NOUT, LERR, OK ) 142 INFOT = 4 143 CALL CGELQT3( 2, 2, A, 1, T, 1, INFO ) 144 CALL CHKXER( 'CGELQT3', INFOT, NOUT, LERR, OK ) 145 INFOT = 6 146 CALL CGELQT3( 2, 2, A, 2, T, 1, INFO ) 147 CALL CHKXER( 'CGELQT3', INFOT, NOUT, LERR, OK ) 148* 149* CGEMLQT 150* 151 SRNAMT = 'CGEMLQT' 152 INFOT = 1 153 CALL CGEMLQT( '/', 'N', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 154 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 155 INFOT = 2 156 CALL CGEMLQT( 'L', '/', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 157 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 158 INFOT = 3 159 CALL CGEMLQT( 'L', 'N', -1, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 160 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 161 INFOT = 4 162 CALL CGEMLQT( 'L', 'N', 0, -1, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 163 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 164 INFOT = 5 165 CALL CGEMLQT( 'L', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 166 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 167 INFOT = 5 168 CALL CGEMLQT( 'R', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 169 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 170 INFOT = 6 171 CALL CGEMLQT( 'L', 'N', 0, 0, 0, 0, A, 1, T, 1, C, 1, W, INFO ) 172 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 173 INFOT = 8 174 CALL CGEMLQT( 'R', 'N', 2, 2, 2, 1, A, 1, T, 1, C, 1, W, INFO ) 175 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 176 INFOT = 8 177 CALL CGEMLQT( 'L', 'N', 2, 2, 2, 1, A, 1, T, 1, C, 1, W, INFO ) 178 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 179 INFOT = 10 180 CALL CGEMLQT( 'R', 'N', 1, 1, 1, 1, A, 1, T, 0, C, 1, W, INFO ) 181 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 182 INFOT = 12 183 CALL CGEMLQT( 'L', 'N', 1, 1, 1, 1, A, 1, T, 1, C, 0, W, INFO ) 184 CALL CHKXER( 'CGEMLQT', INFOT, NOUT, LERR, OK ) 185* 186* Print a summary line. 187* 188 CALL ALAESM( PATH, OK, NOUT ) 189* 190 RETURN 191* 192* End of CERRLQT 193* 194 END 195