 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
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**T*x + beta*y, or 00017 * 00018 * y := alpha*A**H*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**T*x + beta*y. 00033 * 00034 * TRANS = 'C' or 'c' y := alpha*A**H*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 * The vector and matrix arguments are not referenced when N = 0, or M = 0 00099 * 00100 * -- Written on 22-October-1986. 00101 * Jack Dongarra, Argonne National Lab. 00102 * Jeremy Du Croz, Nag Central Office. 00103 * Sven Hammarling, Nag Central Office. 00104 * Richard Hanson, Sandia National Labs. 00105 * 00106 * ===================================================================== 00107 * 00108 * .. Parameters .. 00109 DOUBLE COMPLEX ONE 00110 PARAMETER (ONE= (1.0D+0,0.0D+0)) 00111 DOUBLE COMPLEX ZERO 00112 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 00113 * .. 00114 * .. Local Scalars .. 00115 DOUBLE COMPLEX TEMP 00116 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY 00117 LOGICAL NOCONJ 00118 * .. 00119 * .. External Functions .. 00120 LOGICAL LSAME 00121 EXTERNAL LSAME 00122 * .. 00123 * .. External Subroutines .. 00124 EXTERNAL XERBLA 00125 * .. 00126 * .. Intrinsic Functions .. 00127 INTRINSIC DCONJG,MAX 00128 * .. 00129 * 00130 * Test the input parameters. 00131 * 00132 INFO = 0 00133 IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND. 00134 + .NOT.LSAME(TRANS,'C')) THEN 00135 INFO = 1 00136 ELSE IF (M.LT.0) THEN 00137 INFO = 2 00138 ELSE IF (N.LT.0) THEN 00139 INFO = 3 00140 ELSE IF (LDA.LT.MAX(1,M)) THEN 00141 INFO = 6 00142 ELSE IF (INCX.EQ.0) THEN 00143 INFO = 8 00144 ELSE IF (INCY.EQ.0) THEN 00145 INFO = 11 00146 END IF 00147 IF (INFO.NE.0) THEN 00148 CALL XERBLA('ZGEMV ',INFO) 00149 RETURN 00150 END IF 00151 * 00152 * Quick return if possible. 00153 * 00154 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. 00155 + ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN 00156 * 00157 NOCONJ = LSAME(TRANS,'T') 00158 * 00159 * Set LENX and LENY, the lengths of the vectors x and y, and set 00160 * up the start points in X and Y. 00161 * 00162 IF (LSAME(TRANS,'N')) THEN 00163 LENX = N 00164 LENY = M 00165 ELSE 00166 LENX = M 00167 LENY = N 00168 END IF 00169 IF (INCX.GT.0) THEN 00170 KX = 1 00171 ELSE 00172 KX = 1 - (LENX-1)*INCX 00173 END IF 00174 IF (INCY.GT.0) THEN 00175 KY = 1 00176 ELSE 00177 KY = 1 - (LENY-1)*INCY 00178 END IF 00179 * 00180 * Start the operations. In this version the elements of A are 00181 * accessed sequentially with one pass through A. 00182 * 00183 * First form y := beta*y. 00184 * 00185 IF (BETA.NE.ONE) THEN 00186 IF (INCY.EQ.1) THEN 00187 IF (BETA.EQ.ZERO) THEN 00188 DO 10 I = 1,LENY 00189 Y(I) = ZERO 00190 10 CONTINUE 00191 ELSE 00192 DO 20 I = 1,LENY 00193 Y(I) = BETA*Y(I) 00194 20 CONTINUE 00195 END IF 00196 ELSE 00197 IY = KY 00198 IF (BETA.EQ.ZERO) THEN 00199 DO 30 I = 1,LENY 00200 Y(IY) = ZERO 00201 IY = IY + INCY 00202 30 CONTINUE 00203 ELSE 00204 DO 40 I = 1,LENY 00205 Y(IY) = BETA*Y(IY) 00206 IY = IY + INCY 00207 40 CONTINUE 00208 END IF 00209 END IF 00210 END IF 00211 IF (ALPHA.EQ.ZERO) RETURN 00212 IF (LSAME(TRANS,'N')) THEN 00213 * 00214 * Form y := alpha*A*x + y. 00215 * 00216 JX = KX 00217 IF (INCY.EQ.1) THEN 00218 DO 60 J = 1,N 00219 IF (X(JX).NE.ZERO) THEN 00220 TEMP = ALPHA*X(JX) 00221 DO 50 I = 1,M 00222 Y(I) = Y(I) + TEMP*A(I,J) 00223 50 CONTINUE 00224 END IF 00225 JX = JX + INCX 00226 60 CONTINUE 00227 ELSE 00228 DO 80 J = 1,N 00229 IF (X(JX).NE.ZERO) THEN 00230 TEMP = ALPHA*X(JX) 00231 IY = KY 00232 DO 70 I = 1,M 00233 Y(IY) = Y(IY) + TEMP*A(I,J) 00234 IY = IY + INCY 00235 70 CONTINUE 00236 END IF 00237 JX = JX + INCX 00238 80 CONTINUE 00239 END IF 00240 ELSE 00241 * 00242 * Form y := alpha*A**T*x + y or y := alpha*A**H*x + y. 00243 * 00244 JY = KY 00245 IF (INCX.EQ.1) THEN 00246 DO 110 J = 1,N 00247 TEMP = ZERO 00248 IF (NOCONJ) THEN 00249 DO 90 I = 1,M 00250 TEMP = TEMP + A(I,J)*X(I) 00251 90 CONTINUE 00252 ELSE 00253 DO 100 I = 1,M 00254 TEMP = TEMP + DCONJG(A(I,J))*X(I) 00255 100 CONTINUE 00256 END IF 00257 Y(JY) = Y(JY) + ALPHA*TEMP 00258 JY = JY + INCY 00259 110 CONTINUE 00260 ELSE 00261 DO 140 J = 1,N 00262 TEMP = ZERO 00263 IX = KX 00264 IF (NOCONJ) THEN 00265 DO 120 I = 1,M 00266 TEMP = TEMP + A(I,J)*X(IX) 00267 IX = IX + INCX 00268 120 CONTINUE 00269 ELSE 00270 DO 130 I = 1,M 00271 TEMP = TEMP + DCONJG(A(I,J))*X(IX) 00272 IX = IX + INCX 00273 130 CONTINUE 00274 END IF 00275 Y(JY) = Y(JY) + ALPHA*TEMP 00276 JY = JY + INCY 00277 140 CONTINUE 00278 END IF 00279 END IF 00280 * 00281 RETURN 00282 * 00283 * End of ZGEMV . 00284 * 00285 END
1.7.3 
