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