LAPACK 3.3.1 Linear Algebra PACKage

# dger.f

Go to the documentation of this file.
```00001       SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
00002 *     .. Scalar Arguments ..
00003       DOUBLE PRECISION ALPHA
00004       INTEGER INCX,INCY,LDA,M,N
00005 *     ..
00006 *     .. Array Arguments ..
00007       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
00008 *     ..
00009 *
00010 *  Purpose
00011 *  =======
00012 *
00013 *  DGER   performs the rank 1 operation
00014 *
00015 *     A := alpha*x*y**T + 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  - DOUBLE PRECISION.
00034 *           On entry, ALPHA specifies the scalar alpha.
00035 *           Unchanged on exit.
00036 *
00037 *  X      - DOUBLE PRECISION 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      - DOUBLE PRECISION 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      - DOUBLE PRECISION 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 PRECISION ZERO
00085       PARAMETER (ZERO=0.0D+0)
00086 *     ..
00087 *     .. Local Scalars ..
00088       DOUBLE PRECISION TEMP
00089       INTEGER I,INFO,IX,J,JY,KX
00090 *     ..
00091 *     .. External Subroutines ..
00092       EXTERNAL XERBLA
00093 *     ..
00094 *     .. Intrinsic Functions ..
00095       INTRINSIC 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('DGER  ',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*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*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 DGER  .
00161 *
00162       END
```