```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: *  Further Details
071: *  ===============
072: *
073: *  Level 2 Blas routine.
074: *
075: *  -- Written on 22-October-1986.
076: *     Jack Dongarra, Argonne National Lab.
077: *     Jeremy Du Croz, Nag Central Office.
078: *     Sven Hammarling, Nag Central Office.
079: *     Richard Hanson, Sandia National Labs.
080: *
081: *  =====================================================================
082: *
083: *     .. Parameters ..
084:       REAL ZERO
085:       PARAMETER (ZERO=0.0E+0)
086: *     ..
087: *     .. Local Scalars ..
088:       REAL TEMP
089:       INTEGER I,INFO,IX,J,JY,KX
090: *     ..
091: *     .. External Subroutines ..
092:       EXTERNAL XERBLA
093: *     ..
094: *     .. Intrinsic Functions ..
095:       INTRINSIC MAX
096: *     ..
097: *
098: *     Test the input parameters.
099: *
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('SGER  ',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 SGER  .
161: *
162:       END
163: ```