1*> \brief \b SERRQRT 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 SERRQRT( 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*> SERRQRT tests the error exits for the REAL routines 25*> that use the QRT 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 single_lin 52* 53* ===================================================================== 54 SUBROUTINE SERRQRT( 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 REAL A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 77 $ C( NMAX, NMAX ) 78* .. 79* .. External Subroutines .. 80 EXTERNAL ALAESM, CHKXER, SGEQRT2, SGEQRT3, SGEQRT, 81 $ SGEMQRT 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 FLOAT 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.0 / FLOAT( I+J ) 105 C( I, J ) = 1.0 / FLOAT( I+J ) 106 T( I, J ) = 1.0 / FLOAT( I+J ) 107 END DO 108 W( J ) = 0.0 109 END DO 110 OK = .TRUE. 111* 112* Error exits for QRT factorization 113* 114* SGEQRT 115* 116 SRNAMT = 'SGEQRT' 117 INFOT = 1 118 CALL SGEQRT( -1, 0, 1, A, 1, T, 1, W, INFO ) 119 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 120 INFOT = 2 121 CALL SGEQRT( 0, -1, 1, A, 1, T, 1, W, INFO ) 122 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 123 INFOT = 3 124 CALL SGEQRT( 0, 0, 0, A, 1, T, 1, W, INFO ) 125 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 126 INFOT = 5 127 CALL SGEQRT( 2, 1, 1, A, 1, T, 1, W, INFO ) 128 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 129 INFOT = 7 130 CALL SGEQRT( 2, 2, 2, A, 2, T, 1, W, INFO ) 131 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 132* 133* SGEQRT2 134* 135 SRNAMT = 'SGEQRT2' 136 INFOT = 1 137 CALL SGEQRT2( -1, 0, A, 1, T, 1, INFO ) 138 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 139 INFOT = 2 140 CALL SGEQRT2( 0, -1, A, 1, T, 1, INFO ) 141 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 142 INFOT = 4 143 CALL SGEQRT2( 2, 1, A, 1, T, 1, INFO ) 144 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 145 INFOT = 6 146 CALL SGEQRT2( 2, 2, A, 2, T, 1, INFO ) 147 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 148* 149* SGEQRT3 150* 151 SRNAMT = 'SGEQRT3' 152 INFOT = 1 153 CALL SGEQRT3( -1, 0, A, 1, T, 1, INFO ) 154 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 155 INFOT = 2 156 CALL SGEQRT3( 0, -1, A, 1, T, 1, INFO ) 157 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 158 INFOT = 4 159 CALL SGEQRT3( 2, 1, A, 1, T, 1, INFO ) 160 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 161 INFOT = 6 162 CALL SGEQRT3( 2, 2, A, 2, T, 1, INFO ) 163 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 164* 165* SGEMQRT 166* 167 SRNAMT = 'SGEMQRT' 168 INFOT = 1 169 CALL SGEMQRT( '/', 'N', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 170 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 171 INFOT = 2 172 CALL SGEMQRT( 'L', '/', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 173 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 174 INFOT = 3 175 CALL SGEMQRT( 'L', 'N', -1, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 176 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 177 INFOT = 4 178 CALL SGEMQRT( 'L', 'N', 0, -1, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 179 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 180 INFOT = 5 181 CALL SGEMQRT( 'L', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 182 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 183 INFOT = 5 184 CALL SGEMQRT( 'R', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 185 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 186 INFOT = 6 187 CALL SGEMQRT( 'L', 'N', 0, 0, 0, 0, A, 1, T, 1, C, 1, W, INFO ) 188 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 189 INFOT = 8 190 CALL SGEMQRT( 'R', 'N', 1, 2, 1, 1, A, 1, T, 1, C, 1, W, INFO ) 191 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 192 INFOT = 8 193 CALL SGEMQRT( 'L', 'N', 2, 1, 1, 1, A, 1, T, 1, C, 1, W, INFO ) 194 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 195 INFOT = 10 196 CALL SGEMQRT( 'R', 'N', 1, 1, 1, 1, A, 1, T, 0, C, 1, W, INFO ) 197 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 198 INFOT = 12 199 CALL SGEMQRT( 'L', 'N', 1, 1, 1, 1, A, 1, T, 1, C, 0, W, INFO ) 200 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 201* 202* Print a summary line. 203* 204 CALL ALAESM( PATH, OK, NOUT ) 205* 206 RETURN 207* 208* End of SERRQRT 209* 210 END 211