KTH framework for Nek5000 toolboxes; testing version  0.0.1
dger.f
Go to the documentation of this file.
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
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
Definition: dger.f:2
subroutine xerbla(SRNAME, INFO)
Definition: xerbla.f:2