00001 SUBROUTINE ZGERC(M,N,ALPHA,X,INCX,Y,INCY,A,LDA) 00002 * .. Scalar Arguments .. 00003 DOUBLE COMPLEX ALPHA 00004 INTEGER INCX,INCY,LDA,M,N 00005 * .. 00006 * .. Array Arguments .. 00007 DOUBLE COMPLEX A(LDA,*),X(*),Y(*) 00008 * .. 00009 * 00010 * Purpose 00011 * ======= 00012 * 00013 * ZGERC performs the rank 1 operation 00014 * 00015 * A := alpha*x*conjg( y' ) + A, 00016 * 00017 * where alpha is a scalar, x is an m element vector, y is an n element 00018 * vector and A is an m by n matrix. 00019 * 00020 * Arguments 00021 * ========== 00022 * 00023 * M - INTEGER. 00024 * On entry, M specifies the number of rows of the matrix A. 00025 * M must be at least zero. 00026 * Unchanged on exit. 00027 * 00028 * N - INTEGER. 00029 * On entry, N specifies the number of columns of the matrix A. 00030 * N must be at least zero. 00031 * Unchanged on exit. 00032 * 00033 * ALPHA - COMPLEX*16 . 00034 * On entry, ALPHA specifies the scalar alpha. 00035 * Unchanged on exit. 00036 * 00037 * X - COMPLEX*16 array of dimension at least 00038 * ( 1 + ( m - 1 )*abs( INCX ) ). 00039 * Before entry, the incremented array X must contain the m 00040 * element vector x. 00041 * Unchanged on exit. 00042 * 00043 * INCX - INTEGER. 00044 * On entry, INCX specifies the increment for the elements of 00045 * X. INCX must not be zero. 00046 * Unchanged on exit. 00047 * 00048 * Y - COMPLEX*16 array of dimension at least 00049 * ( 1 + ( n - 1 )*abs( INCY ) ). 00050 * Before entry, the incremented array Y must contain the n 00051 * element vector y. 00052 * Unchanged on exit. 00053 * 00054 * INCY - INTEGER. 00055 * On entry, INCY specifies the increment for the elements of 00056 * Y. INCY must not be zero. 00057 * Unchanged on exit. 00058 * 00059 * A - COMPLEX*16 array of DIMENSION ( LDA, n ). 00060 * Before entry, the leading m by n part of the array A must 00061 * contain the matrix of coefficients. On exit, A is 00062 * overwritten by the updated matrix. 00063 * 00064 * LDA - INTEGER. 00065 * On entry, LDA specifies the first dimension of A as declared 00066 * in the calling (sub) program. LDA must be at least 00067 * max( 1, m ). 00068 * Unchanged on exit. 00069 * 00070 * Further Details 00071 * =============== 00072 * 00073 * Level 2 Blas routine. 00074 * 00075 * -- Written on 22-October-1986. 00076 * Jack Dongarra, Argonne National Lab. 00077 * Jeremy Du Croz, Nag Central Office. 00078 * Sven Hammarling, Nag Central Office. 00079 * Richard Hanson, Sandia National Labs. 00080 * 00081 * ===================================================================== 00082 * 00083 * .. Parameters .. 00084 DOUBLE COMPLEX ZERO 00085 PARAMETER (ZERO= (0.0D+0,0.0D+0)) 00086 * .. 00087 * .. Local Scalars .. 00088 DOUBLE COMPLEX TEMP 00089 INTEGER I,INFO,IX,J,JY,KX 00090 * .. 00091 * .. External Subroutines .. 00092 EXTERNAL XERBLA 00093 * .. 00094 * .. Intrinsic Functions .. 00095 INTRINSIC DCONJG,MAX 00096 * .. 00097 * 00098 * Test the input parameters. 00099 * 00100 INFO = 0 00101 IF (M.LT.0) THEN 00102 INFO = 1 00103 ELSE IF (N.LT.0) THEN 00104 INFO = 2 00105 ELSE IF (INCX.EQ.0) THEN 00106 INFO = 5 00107 ELSE IF (INCY.EQ.0) THEN 00108 INFO = 7 00109 ELSE IF (LDA.LT.MAX(1,M)) THEN 00110 INFO = 9 00111 END IF 00112 IF (INFO.NE.0) THEN 00113 CALL XERBLA('ZGERC ',INFO) 00114 RETURN 00115 END IF 00116 * 00117 * Quick return if possible. 00118 * 00119 IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN 00120 * 00121 * Start the operations. In this version the elements of A are 00122 * accessed sequentially with one pass through A. 00123 * 00124 IF (INCY.GT.0) THEN 00125 JY = 1 00126 ELSE 00127 JY = 1 - (N-1)*INCY 00128 END IF 00129 IF (INCX.EQ.1) THEN 00130 DO 20 J = 1,N 00131 IF (Y(JY).NE.ZERO) THEN 00132 TEMP = ALPHA*DCONJG(Y(JY)) 00133 DO 10 I = 1,M 00134 A(I,J) = A(I,J) + X(I)*TEMP 00135 10 CONTINUE 00136 END IF 00137 JY = JY + INCY 00138 20 CONTINUE 00139 ELSE 00140 IF (INCX.GT.0) THEN 00141 KX = 1 00142 ELSE 00143 KX = 1 - (M-1)*INCX 00144 END IF 00145 DO 40 J = 1,N 00146 IF (Y(JY).NE.ZERO) THEN 00147 TEMP = ALPHA*DCONJG(Y(JY)) 00148 IX = KX 00149 DO 30 I = 1,M 00150 A(I,J) = A(I,J) + X(IX)*TEMP 00151 IX = IX + INCX 00152 30 CONTINUE 00153 END IF 00154 JY = JY + INCY 00155 40 CONTINUE 00156 END IF 00157 * 00158 RETURN 00159 * 00160 * End of ZGERC . 00161 * 00162 END
1.7.2