Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/blas/dger.f
5185 views
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
* .. Array Arguments ..
6
DOUBLE PRECISION A( LDA, * ), X( * ), Y( * )
7
* ..
8
*
9
* Purpose
10
* =======
11
*
12
* DGER 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 - DOUBLE PRECISION.
33
* On entry, ALPHA specifies the scalar alpha.
34
* Unchanged on exit.
35
*
36
* X - DOUBLE PRECISION 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 - DOUBLE PRECISION 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 - DOUBLE PRECISION 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
DOUBLE PRECISION ZERO
81
PARAMETER ( ZERO = 0.0D+0 )
82
* .. Local Scalars ..
83
DOUBLE PRECISION 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( 'DGER ', 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 DGER .
156
*
157
END
158
159