001:       SUBROUTINE SGER(M,N,ALPHA,X,INCX,Y,INCY,A,LDA)
002: *     .. Scalar Arguments ..
003:       REAL ALPHA
004:       INTEGER INCX,INCY,LDA,M,N
005: *     ..
006: *     .. Array Arguments ..
007:       REAL A(LDA,*),X(*),Y(*)
008: *     ..
009: *
010: *  Purpose
011: *  =======
012: *
013: *  SGER   performs the rank 1 operation
014: *
015: *     A := alpha*x*y' + A,
016: *
017: *  where alpha is a scalar, x is an m element vector, y is an n element
018: *  vector and A is an m by n matrix.
019: *
020: *  Arguments
021: *  ==========
022: *
023: *  M      - INTEGER.
024: *           On entry, M specifies the number of rows of the matrix A.
025: *           M must be at least zero.
026: *           Unchanged on exit.
027: *
028: *  N      - INTEGER.
029: *           On entry, N specifies the number of columns of the matrix A.
030: *           N must be at least zero.
031: *           Unchanged on exit.
032: *
033: *  ALPHA  - REAL            .
034: *           On entry, ALPHA specifies the scalar alpha.
035: *           Unchanged on exit.
036: *
037: *  X      - REAL             array of dimension at least
038: *           ( 1 + ( m - 1 )*abs( INCX ) ).
039: *           Before entry, the incremented array X must contain the m
040: *           element vector x.
041: *           Unchanged on exit.
042: *
043: *  INCX   - INTEGER.
044: *           On entry, INCX specifies the increment for the elements of
045: *           X. INCX must not be zero.
046: *           Unchanged on exit.
047: *
048: *  Y      - REAL             array of dimension at least
049: *           ( 1 + ( n - 1 )*abs( INCY ) ).
050: *           Before entry, the incremented array Y must contain the n
051: *           element vector y.
052: *           Unchanged on exit.
053: *
054: *  INCY   - INTEGER.
055: *           On entry, INCY specifies the increment for the elements of
056: *           Y. INCY must not be zero.
057: *           Unchanged on exit.
058: *
059: *  A      - REAL             array of DIMENSION ( LDA, n ).
060: *           Before entry, the leading m by n part of the array A must
061: *           contain the matrix of coefficients. On exit, A is
062: *           overwritten by the updated matrix.
063: *
064: *  LDA    - INTEGER.
065: *           On entry, LDA specifies the first dimension of A as declared
066: *           in the calling (sub) program. LDA must be at least
067: *           max( 1, m ).
068: *           Unchanged on exit.
069: *
070: *
071: *  Level 2 Blas routine.
072: *
073: *  -- Written on 22-October-1986.
074: *     Jack Dongarra, Argonne National Lab.
075: *     Jeremy Du Croz, Nag Central Office.
076: *     Sven Hammarling, Nag Central Office.
077: *     Richard Hanson, Sandia National Labs.
078: *
079: *
080: *     .. Parameters ..
081:       REAL ZERO
082:       PARAMETER (ZERO=0.0E+0)
083: *     ..
084: *     .. Local Scalars ..
085:       REAL TEMP
086:       INTEGER I,INFO,IX,J,JY,KX
087: *     ..
088: *     .. External Subroutines ..
089:       EXTERNAL XERBLA
090: *     ..
091: *     .. Intrinsic Functions ..
092:       INTRINSIC MAX
093: *     ..
094: *
095: *     Test the input parameters.
096: *
097:       INFO = 0
098:       IF (M.LT.0) THEN
099:           INFO = 1
100:       ELSE IF (N.LT.0) THEN
101:           INFO = 2
102:       ELSE IF (INCX.EQ.0) THEN
103:           INFO = 5
104:       ELSE IF (INCY.EQ.0) THEN
105:           INFO = 7
106:       ELSE IF (LDA.LT.MAX(1,M)) THEN
107:           INFO = 9
108:       END IF
109:       IF (INFO.NE.0) THEN
110:           CALL XERBLA('SGER  ',INFO)
111:           RETURN
112:       END IF
113: *
114: *     Quick return if possible.
115: *
116:       IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
117: *
118: *     Start the operations. In this version the elements of A are
119: *     accessed sequentially with one pass through A.
120: *
121:       IF (INCY.GT.0) THEN
122:           JY = 1
123:       ELSE
124:           JY = 1 - (N-1)*INCY
125:       END IF
126:       IF (INCX.EQ.1) THEN
127:           DO 20 J = 1,N
128:               IF (Y(JY).NE.ZERO) THEN
129:                   TEMP = ALPHA*Y(JY)
130:                   DO 10 I = 1,M
131:                       A(I,J) = A(I,J) + X(I)*TEMP
132:    10             CONTINUE
133:               END IF
134:               JY = JY + INCY
135:    20     CONTINUE
136:       ELSE
137:           IF (INCX.GT.0) THEN
138:               KX = 1
139:           ELSE
140:               KX = 1 - (M-1)*INCX
141:           END IF
142:           DO 40 J = 1,N
143:               IF (Y(JY).NE.ZERO) THEN
144:                   TEMP = ALPHA*Y(JY)
145:                   IX = KX
146:                   DO 30 I = 1,M
147:                       A(I,J) = A(I,J) + X(IX)*TEMP
148:                       IX = IX + INCX
149:    30             CONTINUE
150:               END IF
151:               JY = JY + INCY
152:    40     CONTINUE
153:       END IF
154: *
155:       RETURN
156: *
157: *     End of SGER  .
158: *
159:       END
160: