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>