Annotation of rpl/lapack/lapack/zla_geamv.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE ZLA_GEAMV ( TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA,
! 2: $ Y, INCY )
! 3: *
! 4: * -- LAPACK routine (version 3.2.2) --
! 5: * -- Contributed by James Demmel, Deaglan Halligan, Yozo Hida and --
! 6: * -- Jason Riedy of Univ. of California Berkeley. --
! 7: * -- June 2010 --
! 8: *
! 9: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 10: * -- Univ. of California Berkeley and NAG Ltd. --
! 11: *
! 12: IMPLICIT NONE
! 13: * ..
! 14: * .. Scalar Arguments ..
! 15: DOUBLE PRECISION ALPHA, BETA
! 16: INTEGER INCX, INCY, LDA, M, N
! 17: INTEGER TRANS
! 18: * ..
! 19: * .. Array Arguments ..
! 20: COMPLEX*16 A( LDA, * ), X( * )
! 21: DOUBLE PRECISION Y( * )
! 22: * ..
! 23: *
! 24: * Purpose
! 25: * =======
! 26: *
! 27: * ZLA_GEAMV performs one of the matrix-vector operations
! 28: *
! 29: * y := alpha*abs(A)*abs(x) + beta*abs(y),
! 30: * or y := alpha*abs(A)'*abs(x) + beta*abs(y),
! 31: *
! 32: * where alpha and beta are scalars, x and y are vectors and A is an
! 33: * m by n matrix.
! 34: *
! 35: * This function is primarily used in calculating error bounds.
! 36: * To protect against underflow during evaluation, components in
! 37: * the resulting vector are perturbed away from zero by (N+1)
! 38: * times the underflow threshold. To prevent unnecessarily large
! 39: * errors for block-structure embedded in general matrices,
! 40: * "symbolically" zero components are not perturbed. A zero
! 41: * entry is considered "symbolic" if all multiplications involved
! 42: * in computing that entry have at least one zero multiplicand.
! 43: *
! 44: * Arguments
! 45: * ==========
! 46: *
! 47: * TRANS (input) INTEGER
! 48: * On entry, TRANS specifies the operation to be performed as
! 49: * follows:
! 50: *
! 51: * BLAS_NO_TRANS y := alpha*abs(A)*abs(x) + beta*abs(y)
! 52: * BLAS_TRANS y := alpha*abs(A')*abs(x) + beta*abs(y)
! 53: * BLAS_CONJ_TRANS y := alpha*abs(A')*abs(x) + beta*abs(y)
! 54: *
! 55: * Unchanged on exit.
! 56: *
! 57: * M (input) INTEGER
! 58: * On entry, M specifies the number of rows of the matrix A.
! 59: * M must be at least zero.
! 60: * Unchanged on exit.
! 61: *
! 62: * N (input) INTEGER
! 63: * On entry, N specifies the number of columns of the matrix A.
! 64: * N must be at least zero.
! 65: * Unchanged on exit.
! 66: *
! 67: * ALPHA - DOUBLE PRECISION
! 68: * On entry, ALPHA specifies the scalar alpha.
! 69: * Unchanged on exit.
! 70: *
! 71: * A - COMPLEX*16 array of DIMENSION ( LDA, n )
! 72: * Before entry, the leading m by n part of the array A must
! 73: * contain the matrix of coefficients.
! 74: * Unchanged on exit.
! 75: *
! 76: * LDA (input) INTEGER
! 77: * On entry, LDA specifies the first dimension of A as declared
! 78: * in the calling (sub) program. LDA must be at least
! 79: * max( 1, m ).
! 80: * Unchanged on exit.
! 81: *
! 82: * X - COMPLEX*16 array of DIMENSION at least
! 83: * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
! 84: * and at least
! 85: * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
! 86: * Before entry, the incremented array X must contain the
! 87: * vector x.
! 88: * Unchanged on exit.
! 89: *
! 90: * INCX (input) INTEGER
! 91: * On entry, INCX specifies the increment for the elements of
! 92: * X. INCX must not be zero.
! 93: * Unchanged on exit.
! 94: *
! 95: * BETA - DOUBLE PRECISION
! 96: * On entry, BETA specifies the scalar beta. When BETA is
! 97: * supplied as zero then Y need not be set on input.
! 98: * Unchanged on exit.
! 99: *
! 100: * Y (input/output) DOUBLE PRECISION array, dimension
! 101: * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
! 102: * and at least
! 103: * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
! 104: * Before entry with BETA non-zero, the incremented array Y
! 105: * must contain the vector y. On exit, Y is overwritten by the
! 106: * updated vector y.
! 107: *
! 108: * INCY (input) INTEGER
! 109: * On entry, INCY specifies the increment for the elements of
! 110: * Y. INCY must not be zero.
! 111: * Unchanged on exit.
! 112: *
! 113: *
! 114: * Level 2 Blas routine.
! 115: *
! 116: * =====================================================================
! 117: *
! 118: * .. Parameters ..
! 119: COMPLEX*16 ONE, ZERO
! 120: PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
! 121: * ..
! 122: * .. Local Scalars ..
! 123: LOGICAL SYMB_ZERO
! 124: DOUBLE PRECISION TEMP, SAFE1
! 125: INTEGER I, INFO, IY, J, JX, KX, KY, LENX, LENY
! 126: COMPLEX*16 CDUM
! 127: * ..
! 128: * .. External Subroutines ..
! 129: EXTERNAL XERBLA, DLAMCH
! 130: DOUBLE PRECISION DLAMCH
! 131: * ..
! 132: * .. External Functions ..
! 133: EXTERNAL ILATRANS
! 134: INTEGER ILATRANS
! 135: * ..
! 136: * .. Intrinsic Functions ..
! 137: INTRINSIC MAX, ABS, REAL, DIMAG, SIGN
! 138: * ..
! 139: * .. Statement Functions ..
! 140: DOUBLE PRECISION CABS1
! 141: * ..
! 142: * .. Statement Function Definitions ..
! 143: CABS1( CDUM ) = ABS( DBLE( CDUM ) ) + ABS( DIMAG( CDUM ) )
! 144: * ..
! 145: * .. Executable Statements ..
! 146: *
! 147: * Test the input parameters.
! 148: *
! 149: INFO = 0
! 150: IF ( .NOT.( ( TRANS.EQ.ILATRANS( 'N' ) )
! 151: $ .OR. ( TRANS.EQ.ILATRANS( 'T' ) )
! 152: $ .OR. ( TRANS.EQ.ILATRANS( 'C' ) ) ) ) THEN
! 153: INFO = 1
! 154: ELSE IF( M.LT.0 )THEN
! 155: INFO = 2
! 156: ELSE IF( N.LT.0 )THEN
! 157: INFO = 3
! 158: ELSE IF( LDA.LT.MAX( 1, M ) )THEN
! 159: INFO = 6
! 160: ELSE IF( INCX.EQ.0 )THEN
! 161: INFO = 8
! 162: ELSE IF( INCY.EQ.0 )THEN
! 163: INFO = 11
! 164: END IF
! 165: IF( INFO.NE.0 )THEN
! 166: CALL XERBLA( 'ZLA_GEAMV ', INFO )
! 167: RETURN
! 168: END IF
! 169: *
! 170: * Quick return if possible.
! 171: *
! 172: IF( ( M.EQ.0 ).OR.( N.EQ.0 ).OR.
! 173: $ ( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
! 174: $ RETURN
! 175: *
! 176: * Set LENX and LENY, the lengths of the vectors x and y, and set
! 177: * up the start points in X and Y.
! 178: *
! 179: IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
! 180: LENX = N
! 181: LENY = M
! 182: ELSE
! 183: LENX = M
! 184: LENY = N
! 185: END IF
! 186: IF( INCX.GT.0 )THEN
! 187: KX = 1
! 188: ELSE
! 189: KX = 1 - ( LENX - 1 )*INCX
! 190: END IF
! 191: IF( INCY.GT.0 )THEN
! 192: KY = 1
! 193: ELSE
! 194: KY = 1 - ( LENY - 1 )*INCY
! 195: END IF
! 196: *
! 197: * Set SAFE1 essentially to be the underflow threshold times the
! 198: * number of additions in each row.
! 199: *
! 200: SAFE1 = DLAMCH( 'Safe minimum' )
! 201: SAFE1 = (N+1)*SAFE1
! 202: *
! 203: * Form y := alpha*abs(A)*abs(x) + beta*abs(y).
! 204: *
! 205: * The O(M*N) SYMB_ZERO tests could be replaced by O(N) queries to
! 206: * the inexact flag. Still doesn't help change the iteration order
! 207: * to per-column.
! 208: *
! 209: IY = KY
! 210: IF ( INCX.EQ.1 ) THEN
! 211: IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
! 212: DO I = 1, LENY
! 213: IF ( BETA .EQ. 0.0D+0 ) THEN
! 214: SYMB_ZERO = .TRUE.
! 215: Y( IY ) = 0.0D+0
! 216: ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
! 217: SYMB_ZERO = .TRUE.
! 218: ELSE
! 219: SYMB_ZERO = .FALSE.
! 220: Y( IY ) = BETA * ABS( Y( IY ) )
! 221: END IF
! 222: IF ( ALPHA .NE. 0.0D+0 ) THEN
! 223: DO J = 1, LENX
! 224: TEMP = CABS1( A( I, J ) )
! 225: SYMB_ZERO = SYMB_ZERO .AND.
! 226: $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
! 227:
! 228: Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
! 229: END DO
! 230: END IF
! 231:
! 232: IF ( .NOT.SYMB_ZERO ) Y( IY ) =
! 233: $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
! 234:
! 235: IY = IY + INCY
! 236: END DO
! 237: ELSE
! 238: DO I = 1, LENY
! 239: IF ( BETA .EQ. 0.0D+0 ) THEN
! 240: SYMB_ZERO = .TRUE.
! 241: Y( IY ) = 0.0D+0
! 242: ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
! 243: SYMB_ZERO = .TRUE.
! 244: ELSE
! 245: SYMB_ZERO = .FALSE.
! 246: Y( IY ) = BETA * ABS( Y( IY ) )
! 247: END IF
! 248: IF ( ALPHA .NE. 0.0D+0 ) THEN
! 249: DO J = 1, LENX
! 250: TEMP = CABS1( A( J, I ) )
! 251: SYMB_ZERO = SYMB_ZERO .AND.
! 252: $ ( X( J ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
! 253:
! 254: Y( IY ) = Y( IY ) + ALPHA*CABS1( X( J ) )*TEMP
! 255: END DO
! 256: END IF
! 257:
! 258: IF ( .NOT.SYMB_ZERO ) Y( IY ) =
! 259: $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
! 260:
! 261: IY = IY + INCY
! 262: END DO
! 263: END IF
! 264: ELSE
! 265: IF( TRANS.EQ.ILATRANS( 'N' ) )THEN
! 266: DO I = 1, LENY
! 267: IF ( BETA .EQ. 0.0D+0 ) THEN
! 268: SYMB_ZERO = .TRUE.
! 269: Y( IY ) = 0.0D+0
! 270: ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
! 271: SYMB_ZERO = .TRUE.
! 272: ELSE
! 273: SYMB_ZERO = .FALSE.
! 274: Y( IY ) = BETA * ABS( Y( IY ) )
! 275: END IF
! 276: IF ( ALPHA .NE. 0.0D+0 ) THEN
! 277: JX = KX
! 278: DO J = 1, LENX
! 279: TEMP = CABS1( A( I, J ) )
! 280: SYMB_ZERO = SYMB_ZERO .AND.
! 281: $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
! 282:
! 283: Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
! 284: JX = JX + INCX
! 285: END DO
! 286: END IF
! 287:
! 288: IF ( .NOT.SYMB_ZERO ) Y( IY ) =
! 289: $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
! 290:
! 291: IY = IY + INCY
! 292: END DO
! 293: ELSE
! 294: DO I = 1, LENY
! 295: IF ( BETA .EQ. 0.0D+0 ) THEN
! 296: SYMB_ZERO = .TRUE.
! 297: Y( IY ) = 0.0D+0
! 298: ELSE IF ( Y( IY ) .EQ. 0.0D+0 ) THEN
! 299: SYMB_ZERO = .TRUE.
! 300: ELSE
! 301: SYMB_ZERO = .FALSE.
! 302: Y( IY ) = BETA * ABS( Y( IY ) )
! 303: END IF
! 304: IF ( ALPHA .NE. 0.0D+0 ) THEN
! 305: JX = KX
! 306: DO J = 1, LENX
! 307: TEMP = CABS1( A( J, I ) )
! 308: SYMB_ZERO = SYMB_ZERO .AND.
! 309: $ ( X( JX ) .EQ. ZERO .OR. TEMP .EQ. ZERO )
! 310:
! 311: Y( IY ) = Y( IY ) + ALPHA*CABS1( X( JX ) )*TEMP
! 312: JX = JX + INCX
! 313: END DO
! 314: END IF
! 315:
! 316: IF ( .NOT.SYMB_ZERO ) Y( IY ) =
! 317: $ Y( IY ) + SIGN( SAFE1, Y( IY ) )
! 318:
! 319: IY = IY + INCY
! 320: END DO
! 321: END IF
! 322:
! 323: END IF
! 324: *
! 325: RETURN
! 326: *
! 327: * End of ZLA_GEAMV
! 328: *
! 329: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zla_geamv.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack