1 SUBROUTINE CAGEMV( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, 2 $ INCY ) 3* 4* -- PBLAS auxiliary routine (version 2.0) -- 5* University of Tennessee, Knoxville, Oak Ridge National Laboratory, 6* and University of California, Berkeley. 7* April 1, 1998 8* 9* .. Scalar Arguments .. 10 CHARACTER*1 TRANS 11 INTEGER INCX, INCY, LDA, M, N 12 REAL ALPHA, BETA 13* .. 14* .. Array Arguments .. 15 REAL Y( * ) 16 COMPLEX A( LDA, * ), X( * ) 17* .. 18* 19* Purpose 20* ======= 21* 22* CAGEMV performs one of the matrix-vector operations 23* 24* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y ), 25* 26* or 27* 28* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y ), 29* 30* or 31* 32* y := abs( alpha )*abs( conjg( A' ) )*abs( x ) + abs( beta*y ), 33* 34* where alpha and beta are real scalars, y is a real vector, x is a 35* vector and A is an m by n matrix. 36* 37* Arguments 38* ========= 39* 40* TRANS (input) CHARACTER*1 41* On entry, TRANS specifies the operation to be performed as 42* follows: 43* 44* TRANS = 'N' or 'n': 45* y := abs( alpha )*abs( A )*abs( x )+ abs( beta*y ) 46* 47* TRANS = 'T' or 't': 48* y := abs( alpha )*abs( A' )*abs( x ) + abs( beta*y ) 49* 50* TRANS = 'C' or 'c': 51* y := abs( alpha )*abs( conjg( A' ) )*abs( x ) + 52* abs( beta*y ) 53* 54* M (input) INTEGER 55* On entry, M specifies the number of rows of the matrix A. M 56* must be at least zero. 57* 58* N (input) INTEGER 59* On entry, N specifies the number of columns of the matrix A. 60* N must be at least zero. 61* 62* ALPHA (input) REAL 63* On entry, ALPHA specifies the real scalar alpha. 64* 65* A (input) COMPLEX array of dimension ( LDA, n ). 66* On entry, A is an array of dimension ( LDA, N ). The leading 67* m by n part of the array A must contain the matrix of coef- 68* ficients. 69* 70* LDA (input) INTEGER 71* On entry, LDA specifies the leading dimension of the array A. 72* LDA must be at least max( 1, M ). 73* 74* X (input) COMPLEX array of dimension at least 75* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' and at 76* least ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. Before entry, 77* the incremented array X must contain the vector x. 78* 79* INCX (input) INTEGER 80* On entry, INCX specifies the increment for the elements of X. 81* INCX must not be zero. 82* 83* BETA (input) REAL 84* On entry, BETA specifies the real scalar beta. When BETA is 85* supplied as zero then Y need not be set on input. 86* 87* Y (input/output) REAL array of dimension at least 88* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' and at 89* least ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. Before entry 90* with BETA non-zero, the incremented array Y must contain the 91* vector y. On exit, the incremented array Y is overwritten by 92* the updated vector y. 93* 94* INCY (input) INTEGER 95* On entry, INCY specifies the increment for the elements of Y. 96* INCY must not be zero. 97* 98* -- Written on April 1, 1998 by 99* Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 100* 101* ===================================================================== 102* 103* .. Parameters .. 104 REAL ONE, ZERO 105 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 106* .. 107* .. Local Scalars .. 108 INTEGER I, INFO, IX, IY, J, JX, JY, KX, KY, LENX, LENY 109 REAL ABSX, TALPHA, TEMP 110 COMPLEX ZDUM 111* .. 112* .. External Functions .. 113 LOGICAL LSAME 114 EXTERNAL LSAME 115* .. 116* .. External Subroutines .. 117 EXTERNAL XERBLA 118* .. 119* .. Intrinsic Functions .. 120 INTRINSIC ABS, AIMAG, MAX, REAL 121* .. 122* .. Statement Functions .. 123 REAL CABS1 124 CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) ) 125* .. 126* .. Executable Statements .. 127* 128* Test the input parameters. 129* 130 INFO = 0 131 IF( .NOT.LSAME( TRANS, 'N' ) .AND. 132 $ .NOT.LSAME( TRANS, 'T' ) .AND. 133 $ .NOT.LSAME( TRANS, 'C' ) ) THEN 134 INFO = 1 135 ELSE IF( M.LT.0 ) THEN 136 INFO = 2 137 ELSE IF( N.LT.0 ) THEN 138 INFO = 3 139 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN 140 INFO = 6 141 ELSE IF( INCX.EQ.0 ) THEN 142 INFO = 8 143 ELSE IF( INCY.EQ.0 ) THEN 144 INFO = 11 145 END IF 146 IF( INFO.NE.0 ) THEN 147 CALL XERBLA( 'CAGEMV', INFO ) 148 RETURN 149 END IF 150* 151* Quick return if possible. 152* 153 IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR. 154 $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) ) 155 $ RETURN 156* 157* Set LENX and LENY, the lengths of the vectors x and y, and set 158* up the start points in X and Y. 159* 160 IF( LSAME( TRANS, 'N' ) ) THEN 161 LENX = N 162 LENY = M 163 ELSE 164 LENX = M 165 LENY = N 166 END IF 167 IF( INCX.GT.0 ) THEN 168 KX = 1 169 ELSE 170 KX = 1 - ( LENX - 1 )*INCX 171 END IF 172 IF( INCY.GT.0 ) THEN 173 KY = 1 174 ELSE 175 KY = 1 - ( LENY - 1 )*INCY 176 END IF 177* 178* Start the operations. In this version the elements of A are 179* accessed sequentially with one pass through A. 180* 181* First form y := abs( beta*y ). 182* 183 IF( INCY.EQ.1 ) THEN 184 IF( BETA.EQ.ZERO ) THEN 185 DO 10, I = 1, LENY 186 Y( I ) = ZERO 187 10 CONTINUE 188 ELSE IF( BETA.EQ.ONE ) THEN 189 DO 20, I = 1, LENY 190 Y( I ) = ABS( Y( I ) ) 191 20 CONTINUE 192 ELSE 193 DO 30, I = 1, LENY 194 Y( I ) = ABS( BETA * Y( I ) ) 195 30 CONTINUE 196 END IF 197 ELSE 198 IY = KY 199 IF( BETA.EQ.ZERO ) THEN 200 DO 40, I = 1, LENY 201 Y( IY ) = ZERO 202 IY = IY + INCY 203 40 CONTINUE 204 ELSE IF( BETA.EQ.ONE ) THEN 205 DO 50, I = 1, LENY 206 Y( IY ) = ABS( Y( IY ) ) 207 IY = IY + INCY 208 50 CONTINUE 209 ELSE 210 DO 60, I = 1, LENY 211 Y( IY ) = ABS( BETA * Y( IY ) ) 212 IY = IY + INCY 213 60 CONTINUE 214 END IF 215 END IF 216* 217 IF( ALPHA.EQ.ZERO ) 218 $ RETURN 219* 220 TALPHA = ABS( ALPHA ) 221* 222 IF( LSAME( TRANS, 'N' ) ) THEN 223* 224* Form y := abs( alpha ) * abs( A ) * abs( x ) + y. 225* 226 JX = KX 227 IF( INCY.EQ.1 ) THEN 228 DO 80, J = 1, N 229 ABSX = CABS1( X( JX ) ) 230 IF( ABSX.NE.ZERO ) THEN 231 TEMP = TALPHA * ABSX 232 DO 70, I = 1, M 233 Y( I ) = Y( I ) + TEMP * CABS1( A( I, J ) ) 234 70 CONTINUE 235 END IF 236 JX = JX + INCX 237 80 CONTINUE 238 ELSE 239 DO 100, J = 1, N 240 ABSX = CABS1( X( JX ) ) 241 IF( ABSX.NE.ZERO ) THEN 242 TEMP = TALPHA * ABSX 243 IY = KY 244 DO 90, I = 1, M 245 Y( IY ) = Y( IY ) + TEMP * CABS1( A( I, J ) ) 246 IY = IY + INCY 247 90 CONTINUE 248 END IF 249 JX = JX + INCX 250 100 CONTINUE 251 END IF 252* 253 ELSE 254* 255* Form y := abs( alpha ) * abs( A' ) * abs( x ) + y. 256* 257 JY = KY 258 IF( INCX.EQ.1 ) THEN 259 DO 120, J = 1, N 260 TEMP = ZERO 261 DO 110, I = 1, M 262 TEMP = TEMP + CABS1( A( I, J ) ) * CABS1( X( I ) ) 263 110 CONTINUE 264 Y( JY ) = Y( JY ) + TALPHA * TEMP 265 JY = JY + INCY 266 120 CONTINUE 267 ELSE 268 DO 140, J = 1, N 269 TEMP = ZERO 270 IX = KX 271 DO 130, I = 1, M 272 TEMP = TEMP + CABS1( A( I, J ) ) * CABS1( X( IX ) ) 273 IX = IX + INCX 274 130 CONTINUE 275 Y( JY ) = Y( JY ) + TALPHA * TEMP 276 JY = JY + INCY 277 140 CONTINUE 278 END IF 279 END IF 280* 281 RETURN 282* 283* End of CAGEMV 284* 285 END 286