Annotation of rpl/lapack/blas/dger.f, revision 1.4

1.1       bertrand    1:       SUBROUTINE DGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
                      2: *     .. Scalar Arguments ..
                      3:       DOUBLE PRECISION ALPHA
                      4:       INTEGER INCX,INCY,LDA,M,N
                      5: *     ..
                      6: *     .. Array Arguments ..
                      7:       DOUBLE PRECISION A(LDA,*),X(*),Y(*)
                      8: *     ..
                      9: *
                     10: *  Purpose
                     11: *  =======
                     12: *
                     13: *  DGER   performs the rank 1 operation
                     14: *
                     15: *     A := alpha*x*y' + A,
                     16: *
                     17: *  where alpha is a scalar, x is an m element vector, y is an n element
                     18: *  vector and A is an m by n matrix.
                     19: *
                     20: *  Arguments
                     21: *  ==========
                     22: *
                     23: *  M      - INTEGER.
                     24: *           On entry, M specifies the number of rows of the matrix A.
                     25: *           M must be at least zero.
                     26: *           Unchanged on exit.
                     27: *
                     28: *  N      - INTEGER.
                     29: *           On entry, N specifies the number of columns of the matrix A.
                     30: *           N must be at least zero.
                     31: *           Unchanged on exit.
                     32: *
                     33: *  ALPHA  - DOUBLE PRECISION.
                     34: *           On entry, ALPHA specifies the scalar alpha.
                     35: *           Unchanged on exit.
                     36: *
                     37: *  X      - DOUBLE PRECISION array of dimension at least
                     38: *           ( 1 + ( m - 1 )*abs( INCX ) ).
                     39: *           Before entry, the incremented array X must contain the m
                     40: *           element vector x.
                     41: *           Unchanged on exit.
                     42: *
                     43: *  INCX   - INTEGER.
                     44: *           On entry, INCX specifies the increment for the elements of
                     45: *           X. INCX must not be zero.
                     46: *           Unchanged on exit.
                     47: *
                     48: *  Y      - DOUBLE PRECISION array of dimension at least
                     49: *           ( 1 + ( n - 1 )*abs( INCY ) ).
                     50: *           Before entry, the incremented array Y must contain the n
                     51: *           element vector y.
                     52: *           Unchanged on exit.
                     53: *
                     54: *  INCY   - INTEGER.
                     55: *           On entry, INCY specifies the increment for the elements of
                     56: *           Y. INCY must not be zero.
                     57: *           Unchanged on exit.
                     58: *
                     59: *  A      - DOUBLE PRECISION array of DIMENSION ( LDA, n ).
                     60: *           Before entry, the leading m by n part of the array A must
                     61: *           contain the matrix of coefficients. On exit, A is
                     62: *           overwritten by the updated matrix.
                     63: *
                     64: *  LDA    - INTEGER.
                     65: *           On entry, LDA specifies the first dimension of A as declared
                     66: *           in the calling (sub) program. LDA must be at least
                     67: *           max( 1, m ).
                     68: *           Unchanged on exit.
                     69: *
                     70: *  Further Details
                     71: *  ===============
                     72: *
                     73: *  Level 2 Blas routine.
                     74: *
                     75: *  -- Written on 22-October-1986.
                     76: *     Jack Dongarra, Argonne National Lab.
                     77: *     Jeremy Du Croz, Nag Central Office.
                     78: *     Sven Hammarling, Nag Central Office.
                     79: *     Richard Hanson, Sandia National Labs.
                     80: *
                     81: *  =====================================================================
                     82: *
                     83: *     .. Parameters ..
                     84:       DOUBLE PRECISION ZERO
                     85:       PARAMETER (ZERO=0.0D+0)
                     86: *     ..
                     87: *     .. Local Scalars ..
                     88:       DOUBLE PRECISION TEMP
                     89:       INTEGER I,INFO,IX,J,JY,KX
                     90: *     ..
                     91: *     .. External Subroutines ..
                     92:       EXTERNAL XERBLA
                     93: *     ..
                     94: *     .. Intrinsic Functions ..
                     95:       INTRINSIC MAX
                     96: *     ..
                     97: *
                     98: *     Test the input parameters.
                     99: *
                    100:       INFO = 0
                    101:       IF (M.LT.0) THEN
                    102:           INFO = 1
                    103:       ELSE IF (N.LT.0) THEN
                    104:           INFO = 2
                    105:       ELSE IF (INCX.EQ.0) THEN
                    106:           INFO = 5
                    107:       ELSE IF (INCY.EQ.0) THEN
                    108:           INFO = 7
                    109:       ELSE IF (LDA.LT.MAX(1,M)) THEN
                    110:           INFO = 9
                    111:       END IF
                    112:       IF (INFO.NE.0) THEN
                    113:           CALL XERBLA('DGER  ',INFO)
                    114:           RETURN
                    115:       END IF
                    116: *
                    117: *     Quick return if possible.
                    118: *
                    119:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
                    120: *
                    121: *     Start the operations. In this version the elements of A are
                    122: *     accessed sequentially with one pass through A.
                    123: *
                    124:       IF (INCY.GT.0) THEN
                    125:           JY = 1
                    126:       ELSE
                    127:           JY = 1 - (N-1)*INCY
                    128:       END IF
                    129:       IF (INCX.EQ.1) THEN
                    130:           DO 20 J = 1,N
                    131:               IF (Y(JY).NE.ZERO) THEN
                    132:                   TEMP = ALPHA*Y(JY)
                    133:                   DO 10 I = 1,M
                    134:                       A(I,J) = A(I,J) + X(I)*TEMP
                    135:    10             CONTINUE
                    136:               END IF
                    137:               JY = JY + INCY
                    138:    20     CONTINUE
                    139:       ELSE
                    140:           IF (INCX.GT.0) THEN
                    141:               KX = 1
                    142:           ELSE
                    143:               KX = 1 - (M-1)*INCX
                    144:           END IF
                    145:           DO 40 J = 1,N
                    146:               IF (Y(JY).NE.ZERO) THEN
                    147:                   TEMP = ALPHA*Y(JY)
                    148:                   IX = KX
                    149:                   DO 30 I = 1,M
                    150:                       A(I,J) = A(I,J) + X(IX)*TEMP
                    151:                       IX = IX + INCX
                    152:    30             CONTINUE
                    153:               END IF
                    154:               JY = JY + INCY
                    155:    40     CONTINUE
                    156:       END IF
                    157: *
                    158:       RETURN
                    159: *
                    160: *     End of DGER  .
                    161: *
                    162:       END

CVSweb interface <joel.bertrand@systella.fr>