1*DECK CTPMV 2 SUBROUTINE CTPMV (UPLO, TRANS, DIAG, N, AP, X, INCX) 3C***BEGIN PROLOGUE CTPMV 4C***PURPOSE Perform one of the matrix-vector operations. 5C***LIBRARY SLATEC (BLAS) 6C***CATEGORY D1B4 7C***TYPE COMPLEX (STPMV-S, DTPMV-D, CTPMV-C) 8C***KEYWORDS LEVEL 2 BLAS, LINEAR ALGEBRA 9C***AUTHOR Dongarra, J. J., (ANL) 10C Du Croz, J., (NAG) 11C Hammarling, S., (NAG) 12C Hanson, R. J., (SNLA) 13C***DESCRIPTION 14C 15C CTPMV performs one of the matrix-vector operations 16C 17C x := A*x, or x := A'*x, or x := conjg( A')*x, 18C 19C where x is an n element vector and A is an n by n unit, or non-unit, 20C upper or lower triangular matrix, supplied in packed form. 21C 22C Parameters 23C ========== 24C 25C UPLO - CHARACTER*1. 26C On entry, UPLO specifies whether the matrix is an upper or 27C lower triangular matrix as follows: 28C 29C UPLO = 'U' or 'u' A is an upper triangular matrix. 30C 31C UPLO = 'L' or 'l' A is a lower triangular matrix. 32C 33C Unchanged on exit. 34C 35C TRANS - CHARACTER*1. 36C On entry, TRANS specifies the operation to be performed as 37C follows: 38C 39C TRANS = 'N' or 'n' x := A*x. 40C 41C TRANS = 'T' or 't' x := A'*x. 42C 43C TRANS = 'C' or 'c' x := conjg( A' )*x. 44C 45C Unchanged on exit. 46C 47C DIAG - CHARACTER*1. 48C On entry, DIAG specifies whether or not A is unit 49C triangular as follows: 50C 51C DIAG = 'U' or 'u' A is assumed to be unit triangular. 52C 53C DIAG = 'N' or 'n' A is not assumed to be unit 54C triangular. 55C 56C Unchanged on exit. 57C 58C N - INTEGER. 59C On entry, N specifies the order of the matrix A. 60C N must be at least zero. 61C Unchanged on exit. 62C 63C AP - COMPLEX array of DIMENSION at least 64C ( ( n*( n + 1 ) )/2 ). 65C Before entry with UPLO = 'U' or 'u', the array AP must 66C contain the upper triangular matrix packed sequentially, 67C column by column, so that AP( 1 ) contains a( 1, 1 ), 68C AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 ) 69C respectively, and so on. 70C Before entry with UPLO = 'L' or 'l', the array AP must 71C contain the lower triangular matrix packed sequentially, 72C column by column, so that AP( 1 ) contains a( 1, 1 ), 73C AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 ) 74C respectively, and so on. 75C Note that when DIAG = 'U' or 'u', the diagonal elements of 76C A are not referenced, but are assumed to be unity. 77C Unchanged on exit. 78C 79C X - COMPLEX array of dimension at least 80C ( 1 + ( n - 1 )*abs( INCX ) ). 81C Before entry, the incremented array X must contain the n 82C element vector x. On exit, X is overwritten with the 83C transformed vector x. 84C 85C INCX - INTEGER. 86C On entry, INCX specifies the increment for the elements of 87C X. INCX must not be zero. 88C Unchanged on exit. 89C 90C***REFERENCES Dongarra, J. J., Du Croz, J., Hammarling, S., and 91C Hanson, R. J. An extended set of Fortran basic linear 92C algebra subprograms. ACM TOMS, Vol. 14, No. 1, 93C pp. 1-17, March 1988. 94C***ROUTINES CALLED LSAME, XERBLA 95C***REVISION HISTORY (YYMMDD) 96C 861022 DATE WRITTEN 97C 910605 Modified to meet SLATEC prologue standards. Only comment 98C lines were modified. (BKS) 99C***END PROLOGUE CTPMV 100C .. Scalar Arguments .. 101 INTEGER INCX, N 102 CHARACTER*1 DIAG, TRANS, UPLO 103C .. Array Arguments .. 104 COMPLEX AP( * ), X( * ) 105C .. Parameters .. 106 COMPLEX ZERO 107 PARAMETER ( ZERO = ( 0.0E+0, 0.0E+0 ) ) 108C .. Local Scalars .. 109 COMPLEX TEMP 110 INTEGER I, INFO, IX, J, JX, K, KK, KX 111 LOGICAL NOCONJ, NOUNIT 112C .. External Functions .. 113 LOGICAL LSAME 114 EXTERNAL LSAME 115C .. External Subroutines .. 116 EXTERNAL XERBLA 117C .. Intrinsic Functions .. 118 INTRINSIC CONJG 119C***FIRST EXECUTABLE STATEMENT CTPMV 120C 121C Test the input parameters. 122C 123 INFO = 0 124 IF ( .NOT.LSAME( UPLO , 'U' ).AND. 125 $ .NOT.LSAME( UPLO , 'L' ) )THEN 126 INFO = 1 127 ELSE IF( .NOT.LSAME( TRANS, 'N' ).AND. 128 $ .NOT.LSAME( TRANS, 'T' ).AND. 129 $ .NOT.LSAME( TRANS, 'C' ) )THEN 130 INFO = 2 131 ELSE IF( .NOT.LSAME( DIAG , 'U' ).AND. 132 $ .NOT.LSAME( DIAG , 'N' ) )THEN 133 INFO = 3 134 ELSE IF( N.LT.0 )THEN 135 INFO = 4 136 ELSE IF( INCX.EQ.0 )THEN 137 INFO = 7 138 END IF 139 IF( INFO.NE.0 )THEN 140 CALL XERBLA( 'CTPMV ', INFO ) 141 RETURN 142 END IF 143C 144C Quick return if possible. 145C 146 IF( N.EQ.0 ) 147 $ RETURN 148C 149 NOCONJ = LSAME( TRANS, 'T' ) 150 NOUNIT = LSAME( DIAG , 'N' ) 151C 152C Set up the start point in X if the increment is not unity. This 153C will be ( N - 1 )*INCX too small for descending loops. 154C 155 IF( INCX.LE.0 )THEN 156 KX = 1 - ( N - 1 )*INCX 157 ELSE IF( INCX.NE.1 )THEN 158 KX = 1 159 END IF 160C 161C Start the operations. In this version the elements of AP are 162C accessed sequentially with one pass through AP. 163C 164 IF( LSAME( TRANS, 'N' ) )THEN 165C 166C Form x:= A*x. 167C 168 IF( LSAME( UPLO, 'U' ) )THEN 169 KK = 1 170 IF( INCX.EQ.1 )THEN 171 DO 20, J = 1, N 172 IF( X( J ).NE.ZERO )THEN 173 TEMP = X( J ) 174 K = KK 175 DO 10, I = 1, J - 1 176 X( I ) = X( I ) + TEMP*AP( K ) 177 K = K + 1 178 10 CONTINUE 179 IF( NOUNIT ) 180 $ X( J ) = X( J )*AP( KK + J - 1 ) 181 END IF 182 KK = KK + J 183 20 CONTINUE 184 ELSE 185 JX = KX 186 DO 40, J = 1, N 187 IF( X( JX ).NE.ZERO )THEN 188 TEMP = X( JX ) 189 IX = KX 190 DO 30, K = KK, KK + J - 2 191 X( IX ) = X( IX ) + TEMP*AP( K ) 192 IX = IX + INCX 193 30 CONTINUE 194 IF( NOUNIT ) 195 $ X( JX ) = X( JX )*AP( KK + J - 1 ) 196 END IF 197 JX = JX + INCX 198 KK = KK + J 199 40 CONTINUE 200 END IF 201 ELSE 202 KK = ( N*( N + 1 ) )/2 203 IF( INCX.EQ.1 )THEN 204 DO 60, J = N, 1, -1 205 IF( X( J ).NE.ZERO )THEN 206 TEMP = X( J ) 207 K = KK 208 DO 50, I = N, J + 1, -1 209 X( I ) = X( I ) + TEMP*AP( K ) 210 K = K - 1 211 50 CONTINUE 212 IF( NOUNIT ) 213 $ X( J ) = X( J )*AP( KK - N + J ) 214 END IF 215 KK = KK - ( N - J + 1 ) 216 60 CONTINUE 217 ELSE 218 KX = KX + ( N - 1 )*INCX 219 JX = KX 220 DO 80, J = N, 1, -1 221 IF( X( JX ).NE.ZERO )THEN 222 TEMP = X( JX ) 223 IX = KX 224 DO 70, K = KK, KK - ( N - ( J + 1 ) ), -1 225 X( IX ) = X( IX ) + TEMP*AP( K ) 226 IX = IX - INCX 227 70 CONTINUE 228 IF( NOUNIT ) 229 $ X( JX ) = X( JX )*AP( KK - N + J ) 230 END IF 231 JX = JX - INCX 232 KK = KK - ( N - J + 1 ) 233 80 CONTINUE 234 END IF 235 END IF 236 ELSE 237C 238C Form x := A'*x or x := conjg( A' )*x. 239C 240 IF( LSAME( UPLO, 'U' ) )THEN 241 KK = ( N*( N + 1 ) )/2 242 IF( INCX.EQ.1 )THEN 243 DO 110, J = N, 1, -1 244 TEMP = X( J ) 245 K = KK - 1 246 IF( NOCONJ )THEN 247 IF( NOUNIT ) 248 $ TEMP = TEMP*AP( KK ) 249 DO 90, I = J - 1, 1, -1 250 TEMP = TEMP + AP( K )*X( I ) 251 K = K - 1 252 90 CONTINUE 253 ELSE 254 IF( NOUNIT ) 255 $ TEMP = TEMP*CONJG( AP( KK ) ) 256 DO 100, I = J - 1, 1, -1 257 TEMP = TEMP + CONJG( AP( K ) )*X( I ) 258 K = K - 1 259 100 CONTINUE 260 END IF 261 X( J ) = TEMP 262 KK = KK - J 263 110 CONTINUE 264 ELSE 265 JX = KX + ( N - 1 )*INCX 266 DO 140, J = N, 1, -1 267 TEMP = X( JX ) 268 IX = JX 269 IF( NOCONJ )THEN 270 IF( NOUNIT ) 271 $ TEMP = TEMP*AP( KK ) 272 DO 120, K = KK - 1, KK - J + 1, -1 273 IX = IX - INCX 274 TEMP = TEMP + AP( K )*X( IX ) 275 120 CONTINUE 276 ELSE 277 IF( NOUNIT ) 278 $ TEMP = TEMP*CONJG( AP( KK ) ) 279 DO 130, K = KK - 1, KK - J + 1, -1 280 IX = IX - INCX 281 TEMP = TEMP + CONJG( AP( K ) )*X( IX ) 282 130 CONTINUE 283 END IF 284 X( JX ) = TEMP 285 JX = JX - INCX 286 KK = KK - J 287 140 CONTINUE 288 END IF 289 ELSE 290 KK = 1 291 IF( INCX.EQ.1 )THEN 292 DO 170, J = 1, N 293 TEMP = X( J ) 294 K = KK + 1 295 IF( NOCONJ )THEN 296 IF( NOUNIT ) 297 $ TEMP = TEMP*AP( KK ) 298 DO 150, I = J + 1, N 299 TEMP = TEMP + AP( K )*X( I ) 300 K = K + 1 301 150 CONTINUE 302 ELSE 303 IF( NOUNIT ) 304 $ TEMP = TEMP*CONJG( AP( KK ) ) 305 DO 160, I = J + 1, N 306 TEMP = TEMP + CONJG( AP( K ) )*X( I ) 307 K = K + 1 308 160 CONTINUE 309 END IF 310 X( J ) = TEMP 311 KK = KK + ( N - J + 1 ) 312 170 CONTINUE 313 ELSE 314 JX = KX 315 DO 200, J = 1, N 316 TEMP = X( JX ) 317 IX = JX 318 IF( NOCONJ )THEN 319 IF( NOUNIT ) 320 $ TEMP = TEMP*AP( KK ) 321 DO 180, K = KK + 1, KK + N - J 322 IX = IX + INCX 323 TEMP = TEMP + AP( K )*X( IX ) 324 180 CONTINUE 325 ELSE 326 IF( NOUNIT ) 327 $ TEMP = TEMP*CONJG( AP( KK ) ) 328 DO 190, K = KK + 1, KK + N - J 329 IX = IX + INCX 330 TEMP = TEMP + CONJG( AP( K ) )*X( IX ) 331 190 CONTINUE 332 END IF 333 X( JX ) = TEMP 334 JX = JX + INCX 335 KK = KK + ( N - J + 1 ) 336 200 CONTINUE 337 END IF 338 END IF 339 END IF 340C 341 RETURN 342C 343C End of CTPMV . 344C 345 END 346