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*> \date November 2011 52* 53*> \ingroup single_lin 54* 55* ===================================================================== 56 SUBROUTINE SERRQRT( PATH, NUNIT ) 57 IMPLICIT NONE 58* 59* -- LAPACK test routine (version 3.4.0) -- 60* -- LAPACK is a software package provided by Univ. of Tennessee, -- 61* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 62* November 2011 63* 64* .. Scalar Arguments .. 65 CHARACTER*3 PATH 66 INTEGER NUNIT 67* .. 68* 69* ===================================================================== 70* 71* .. Parameters .. 72 INTEGER NMAX 73 PARAMETER ( NMAX = 2 ) 74* .. 75* .. Local Scalars .. 76 INTEGER I, INFO, J 77* .. 78* .. Local Arrays .. 79 REAL A( NMAX, NMAX ), T( NMAX, NMAX ), W( NMAX ), 80 $ C( NMAX, NMAX ) 81* .. 82* .. External Subroutines .. 83 EXTERNAL ALAESM, CHKXER, SGEQRT2, SGEQRT3, SGEQRT, 84 $ SGEMQRT 85* .. 86* .. Scalars in Common .. 87 LOGICAL LERR, OK 88 CHARACTER*32 SRNAMT 89 INTEGER INFOT, NOUT 90* .. 91* .. Common blocks .. 92 COMMON / INFOC / INFOT, NOUT, OK, LERR 93 COMMON / SRNAMC / SRNAMT 94* .. 95* .. Intrinsic Functions .. 96 INTRINSIC FLOAT 97* .. 98* .. Executable Statements .. 99* 100 NOUT = NUNIT 101 WRITE( NOUT, FMT = * ) 102* 103* Set the variables to innocuous values. 104* 105 DO J = 1, NMAX 106 DO I = 1, NMAX 107 A( I, J ) = 1.0 / FLOAT( I+J ) 108 C( I, J ) = 1.0 / FLOAT( I+J ) 109 T( I, J ) = 1.0 / FLOAT( I+J ) 110 END DO 111 W( J ) = 0.0 112 END DO 113 OK = .TRUE. 114* 115* Error exits for QRT factorization 116* 117* SGEQRT 118* 119 SRNAMT = 'SGEQRT' 120 INFOT = 1 121 CALL SGEQRT( -1, 0, 1, A, 1, T, 1, W, INFO ) 122 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 123 INFOT = 2 124 CALL SGEQRT( 0, -1, 1, A, 1, T, 1, W, INFO ) 125 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 126 INFOT = 3 127 CALL SGEQRT( 0, 0, 0, A, 1, T, 1, W, INFO ) 128 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 129 INFOT = 5 130 CALL SGEQRT( 2, 1, 1, A, 1, T, 1, W, INFO ) 131 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 132 INFOT = 7 133 CALL SGEQRT( 2, 2, 2, A, 2, T, 1, W, INFO ) 134 CALL CHKXER( 'SGEQRT', INFOT, NOUT, LERR, OK ) 135* 136* SGEQRT2 137* 138 SRNAMT = 'SGEQRT2' 139 INFOT = 1 140 CALL SGEQRT2( -1, 0, A, 1, T, 1, INFO ) 141 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 142 INFOT = 2 143 CALL SGEQRT2( 0, -1, A, 1, T, 1, INFO ) 144 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 145 INFOT = 4 146 CALL SGEQRT2( 2, 1, A, 1, T, 1, INFO ) 147 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 148 INFOT = 6 149 CALL SGEQRT2( 2, 2, A, 2, T, 1, INFO ) 150 CALL CHKXER( 'SGEQRT2', INFOT, NOUT, LERR, OK ) 151* 152* SGEQRT3 153* 154 SRNAMT = 'SGEQRT3' 155 INFOT = 1 156 CALL SGEQRT3( -1, 0, A, 1, T, 1, INFO ) 157 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 158 INFOT = 2 159 CALL SGEQRT3( 0, -1, A, 1, T, 1, INFO ) 160 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 161 INFOT = 4 162 CALL SGEQRT3( 2, 1, A, 1, T, 1, INFO ) 163 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 164 INFOT = 6 165 CALL SGEQRT3( 2, 2, A, 2, T, 1, INFO ) 166 CALL CHKXER( 'SGEQRT3', INFOT, NOUT, LERR, OK ) 167* 168* SGEMQRT 169* 170 SRNAMT = 'SGEMQRT' 171 INFOT = 1 172 CALL SGEMQRT( '/', 'N', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 173 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 174 INFOT = 2 175 CALL SGEMQRT( 'L', '/', 0, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 176 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 177 INFOT = 3 178 CALL SGEMQRT( 'L', 'N', -1, 0, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 179 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 180 INFOT = 4 181 CALL SGEMQRT( 'L', 'N', 0, -1, 0, 1, A, 1, T, 1, C, 1, W, INFO ) 182 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 183 INFOT = 5 184 CALL SGEMQRT( 'L', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 185 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 186 INFOT = 5 187 CALL SGEMQRT( 'R', 'N', 0, 0, -1, 1, A, 1, T, 1, C, 1, W, INFO ) 188 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 189 INFOT = 6 190 CALL SGEMQRT( 'L', 'N', 0, 0, 0, 0, A, 1, T, 1, C, 1, W, INFO ) 191 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 192 INFOT = 8 193 CALL SGEMQRT( 'R', 'N', 1, 2, 1, 1, A, 1, T, 1, C, 1, W, INFO ) 194 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 195 INFOT = 8 196 CALL SGEMQRT( 'L', 'N', 2, 1, 1, 1, A, 1, T, 1, C, 1, W, INFO ) 197 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 198 INFOT = 10 199 CALL SGEMQRT( 'R', 'N', 1, 1, 1, 1, A, 1, T, 0, C, 1, W, INFO ) 200 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 201 INFOT = 12 202 CALL SGEMQRT( 'L', 'N', 1, 1, 1, 1, A, 1, T, 1, C, 0, W, INFO ) 203 CALL CHKXER( 'SGEMQRT', INFOT, NOUT, LERR, OK ) 204* 205* Print a summary line. 206* 207 CALL ALAESM( PATH, OK, NOUT ) 208* 209 RETURN 210* 211* End of SERRQRT 212* 213 END 214