 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) 00002 * .. Scalar Arguments .. 00003 REAL ALPHA,BETA 00004 INTEGER INCX,INCY,LDA,M,N 00005 CHARACTER TRANS 00006 * .. 00007 * .. Array Arguments .. 00008 REAL A(LDA,*),X(*),Y(*) 00009 * .. 00010 * 00011 * Purpose 00012 * ======= 00013 * 00014 * SGEMV performs one of the matrix-vector operations 00015 * 00016 * y := alpha*A*x + beta*y, or y := alpha*A**T*x + beta*y, 00017 * 00018 * where alpha and beta are scalars, x and y are vectors and A is an 00019 * m by n matrix. 00020 * 00021 * Arguments 00022 * ========== 00023 * 00024 * TRANS - CHARACTER*1. 00025 * On entry, TRANS specifies the operation to be performed as 00026 * follows: 00027 * 00028 * TRANS = 'N' or 'n' y := alpha*A*x + beta*y. 00029 * 00030 * TRANS = 'T' or 't' y := alpha*A**T*x + beta*y. 00031 * 00032 * TRANS = 'C' or 'c' y := alpha*A**T*x + beta*y. 00033 * 00034 * Unchanged on exit. 00035 * 00036 * M - INTEGER. 00037 * On entry, M specifies the number of rows of the matrix A. 00038 * M must be at least zero. 00039 * Unchanged on exit. 00040 * 00041 * N - INTEGER. 00042 * On entry, N specifies the number of columns of the matrix A. 00043 * N must be at least zero. 00044 * Unchanged on exit. 00045 * 00046 * ALPHA - REAL . 00047 * On entry, ALPHA specifies the scalar alpha. 00048 * Unchanged on exit. 00049 * 00050 * A - REAL array of DIMENSION ( LDA, n ). 00051 * Before entry, the leading m by n part of the array A must 00052 * contain the matrix of coefficients. 00053 * Unchanged on exit. 00054 * 00055 * LDA - INTEGER. 00056 * On entry, LDA specifies the first dimension of A as declared 00057 * in the calling (sub) program. LDA must be at least 00058 * max( 1, m ). 00059 * Unchanged on exit. 00060 * 00061 * X - REAL array of DIMENSION at least 00062 * ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' 00063 * and at least 00064 * ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. 00065 * Before entry, the incremented array X must contain the 00066 * vector x. 00067 * Unchanged on exit. 00068 * 00069 * INCX - INTEGER. 00070 * On entry, INCX specifies the increment for the elements of 00071 * X. INCX must not be zero. 00072 * Unchanged on exit. 00073 * 00074 * BETA - REAL . 00075 * On entry, BETA specifies the scalar beta. When BETA is 00076 * supplied as zero then Y need not be set on input. 00077 * Unchanged on exit. 00078 * 00079 * Y - REAL array of DIMENSION at least 00080 * ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' 00081 * and at least 00082 * ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. 00083 * Before entry with BETA non-zero, the incremented array Y 00084 * must contain the vector y. On exit, Y is overwritten by the 00085 * updated vector y. 00086 * 00087 * INCY - INTEGER. 00088 * On entry, INCY specifies the increment for the elements of 00089 * Y. INCY must not be zero. 00090 * Unchanged on exit. 00091 * 00092 * Further Details 00093 * =============== 00094 * 00095 * Level 2 Blas routine. 00096 * The vector and matrix arguments are not referenced when N = 0, or M = 0 00097 * 00098 * -- Written on 22-October-1986. 00099 * Jack Dongarra, Argonne National Lab. 00100 * Jeremy Du Croz, Nag Central Office. 00101 * Sven Hammarling, Nag Central Office. 00102 * Richard Hanson, Sandia National Labs. 00103 * 00104 * ===================================================================== 00105 * 00106 * .. Parameters .. 00107 REAL ONE,ZERO 00108 PARAMETER (ONE=1.0E+0,ZERO=0.0E+0) 00109 * .. 00110 * .. Local Scalars .. 00111 REAL TEMP 00112 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY 00113 * .. 00114 * .. External Functions .. 00115 LOGICAL LSAME 00116 EXTERNAL LSAME 00117 * .. 00118 * .. External Subroutines .. 00119 EXTERNAL XERBLA 00120 * .. 00121 * .. Intrinsic Functions .. 00122 INTRINSIC MAX 00123 * .. 00124 * 00125 * Test the input parameters. 00126 * 00127 INFO = 0 00128 IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. 00129 + .NOT.LSAME(TRANS,'C')) THEN 00130 INFO = 1 00131 ELSE IF (M.LT.0) THEN 00132 INFO = 2 00133 ELSE IF (N.LT.0) THEN 00134 INFO = 3 00135 ELSE IF (LDA.LT.MAX(1,M)) THEN 00136 INFO = 6 00137 ELSE IF (INCX.EQ.0) THEN 00138 INFO = 8 00139 ELSE IF (INCY.EQ.0) THEN 00140 INFO = 11 00141 END IF 00142 IF (INFO.NE.0) THEN 00143 CALL XERBLA('SGEMV ',INFO) 00144 RETURN 00145 END IF 00146 * 00147 * Quick return if possible. 00148 * 00149 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 00150 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 00151 * 00152 * Set LENX and LENY, the lengths of the vectors x and y, and set 00153 * up the start points in X and Y. 00154 * 00155 IF (LSAME(TRANS,'N')) THEN 00156 LENX = N 00157 LENY = M 00158 ELSE 00159 LENX = M 00160 LENY = N 00161 END IF 00162 IF (INCX.GT.0) THEN 00163 KX = 1 00164 ELSE 00165 KX = 1 - (LENX-1)*INCX 00166 END IF 00167 IF (INCY.GT.0) THEN 00168 KY = 1 00169 ELSE 00170 KY = 1 - (LENY-1)*INCY 00171 END IF 00172 * 00173 * Start the operations. In this version the elements of A are 00174 * accessed sequentially with one pass through A. 00175 * 00176 * First form y := beta*y. 00177 * 00178 IF (BETA.NE.ONE) THEN 00179 IF (INCY.EQ.1) THEN 00180 IF (BETA.EQ.ZERO) THEN 00181 DO 10 I = 1,LENY 00182 Y(I) = ZERO 00183 10 CONTINUE 00184 ELSE 00185 DO 20 I = 1,LENY 00186 Y(I) = BETA*Y(I) 00187 20 CONTINUE 00188 END IF 00189 ELSE 00190 IY = KY 00191 IF (BETA.EQ.ZERO) THEN 00192 DO 30 I = 1,LENY 00193 Y(IY) = ZERO 00194 IY = IY + INCY 00195 30 CONTINUE 00196 ELSE 00197 DO 40 I = 1,LENY 00198 Y(IY) = BETA*Y(IY) 00199 IY = IY + INCY 00200 40 CONTINUE 00201 END IF 00202 END IF 00203 END IF 00204 IF (ALPHA.EQ.ZERO) RETURN 00205 IF (LSAME(TRANS,'N')) THEN 00206 * 00207 * Form y := alpha*A*x + y. 00208 * 00209 JX = KX 00210 IF (INCY.EQ.1) THEN 00211 DO 60 J = 1,N 00212 IF (X(JX).NE.ZERO) THEN 00213 TEMP = ALPHA*X(JX) 00214 DO 50 I = 1,M 00215 Y(I) = Y(I) + TEMP*A(I,J) 00216 50 CONTINUE 00217 END IF 00218 JX = JX + INCX 00219 60 CONTINUE 00220 ELSE 00221 DO 80 J = 1,N 00222 IF (X(JX).NE.ZERO) THEN 00223 TEMP = ALPHA*X(JX) 00224 IY = KY 00225 DO 70 I = 1,M 00226 Y(IY) = Y(IY) + TEMP*A(I,J) 00227 IY = IY + INCY 00228 70 CONTINUE 00229 END IF 00230 JX = JX + INCX 00231 80 CONTINUE 00232 END IF 00233 ELSE 00234 * 00235 * Form y := alpha*A**T*x + y. 00236 * 00237 JY = KY 00238 IF (INCX.EQ.1) THEN 00239 DO 100 J = 1,N 00240 TEMP = ZERO 00241 DO 90 I = 1,M 00242 TEMP = TEMP + A(I,J)*X(I) 00243 90 CONTINUE 00244 Y(JY) = Y(JY) + ALPHA*TEMP 00245 JY = JY + INCY 00246 100 CONTINUE 00247 ELSE 00248 DO 120 J = 1,N 00249 TEMP = ZERO 00250 IX = KX 00251 DO 110 I = 1,M 00252 TEMP = TEMP + A(I,J)*X(IX) 00253 IX = IX + INCX 00254 110 CONTINUE 00255 Y(JY) = Y(JY) + ALPHA*TEMP 00256 JY = JY + INCY 00257 120 CONTINUE 00258 END IF 00259 END IF 00260 * 00261 RETURN 00262 * 00263 * End of SGEMV . 00264 * 00265 END
1.7.3 
