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