1*> \brief \b DERRLQTP 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 SERRLQTP( 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*> SERRLQTP tests the error exits for the REAL routines 25*> that use the LQT decomposition of a triangular-pentagonal 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 December 2016 52* 53*> \ingroup double_lin 54* 55* ===================================================================== 56 SUBROUTINE SERRLQTP( PATH, NUNIT ) 57 IMPLICIT NONE 58* 59* -- LAPACK test routine (version 3.7.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* December 2016 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 $ B( NMAX, NMAX ), C( NMAX, NMAX ) 81* .. 82* .. External Subroutines .. 83 EXTERNAL ALAESM, CHKXER, STPLQT2, STPLQT, 84 $ STPMLQT 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 REAL 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.D0 / REAL( I+J ) 108 C( I, J ) = 1.D0 / REAL( I+J ) 109 T( I, J ) = 1.D0 / REAL( I+J ) 110 END DO 111 W( J ) = 0.0 112 END DO 113 OK = .TRUE. 114* 115* Error exits for TPLQT factorization 116* 117* STPLQT 118* 119 SRNAMT = 'STPLQT' 120 INFOT = 1 121 CALL STPLQT( -1, 1, 0, 1, A, 1, B, 1, T, 1, W, INFO ) 122 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 123 INFOT = 2 124 CALL STPLQT( 1, -1, 0, 1, A, 1, B, 1, T, 1, W, INFO ) 125 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 126 INFOT = 3 127 CALL STPLQT( 0, 1, -1, 1, A, 1, B, 1, T, 1, W, INFO ) 128 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 129 INFOT = 3 130 CALL STPLQT( 0, 1, 1, 1, A, 1, B, 1, T, 1, W, INFO ) 131 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 132 INFOT = 4 133 CALL STPLQT( 0, 1, 0, 0, A, 1, B, 1, T, 1, W, INFO ) 134 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 135 INFOT = 4 136 CALL STPLQT( 1, 1, 0, 2, A, 1, B, 1, T, 1, W, INFO ) 137 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 138 INFOT = 6 139 CALL STPLQT( 2, 1, 0, 2, A, 1, B, 1, T, 1, W, INFO ) 140 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 141 INFOT = 8 142 CALL STPLQT( 2, 1, 0, 1, A, 2, B, 1, T, 1, W, INFO ) 143 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 144 INFOT = 10 145 CALL STPLQT( 2, 2, 1, 2, A, 2, B, 2, T, 1, W, INFO ) 146 CALL CHKXER( 'STPLQT', INFOT, NOUT, LERR, OK ) 147* 148* STPLQT2 149* 150 SRNAMT = 'STPLQT2' 151 INFOT = 1 152 CALL STPLQT2( -1, 0, 0, A, 1, B, 1, T, 1, INFO ) 153 CALL CHKXER( 'STPLQT2', INFOT, NOUT, LERR, OK ) 154 INFOT = 2 155 CALL STPLQT2( 0, -1, 0, A, 1, B, 1, T, 1, INFO ) 156 CALL CHKXER( 'STPLQT2', INFOT, NOUT, LERR, OK ) 157 INFOT = 3 158 CALL STPLQT2( 0, 0, -1, A, 1, B, 1, T, 1, INFO ) 159 CALL CHKXER( 'STPLQT2', INFOT, NOUT, LERR, OK ) 160 INFOT = 5 161 CALL STPLQT2( 2, 2, 0, A, 1, B, 2, T, 2, INFO ) 162 CALL CHKXER( 'STPLQT2', INFOT, NOUT, LERR, OK ) 163 INFOT = 7 164 CALL STPLQT2( 2, 2, 0, A, 2, B, 1, T, 2, INFO ) 165 CALL CHKXER( 'STPLQT2', INFOT, NOUT, LERR, OK ) 166 INFOT = 9 167 CALL STPLQT2( 2, 2, 0, A, 2, B, 2, T, 1, INFO ) 168 CALL CHKXER( 'STPLQT2', INFOT, NOUT, LERR, OK ) 169* 170* STPMLQT 171* 172 SRNAMT = 'STPMLQT' 173 INFOT = 1 174 CALL STPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 175 $ W, INFO ) 176 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 177 INFOT = 2 178 CALL STPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 179 $ W, INFO ) 180 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 181 INFOT = 3 182 CALL STPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 183 $ W, INFO ) 184 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 185 INFOT = 4 186 CALL STPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, 187 $ W, INFO ) 188 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 189 INFOT = 5 190 CALL STPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, 191 $ W, INFO ) 192 INFOT = 6 193 CALL STPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, 194 $ W, INFO ) 195 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 196 INFOT = 7 197 CALL STPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, 198 $ W, INFO ) 199 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 200 INFOT = 9 201 CALL STPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, 202 $ W, INFO ) 203 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 204 INFOT = 11 205 CALL STPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, 206 $ W, INFO ) 207 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 208 INFOT = 13 209 CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, 210 $ W, INFO ) 211 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 212 INFOT = 15 213 CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, 214 $ W, INFO ) 215 CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) 216* 217* Print a summary line. 218* 219 CALL ALAESM( PATH, OK, NOUT ) 220* 221 RETURN 222* 223* End of SERRLQT 224* 225 END 226