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