Free cookie consent management tool by TermsFeed Policy Generator

source: branches/2789_MathNetNumerics-Exploration/HeuristicLab.Algorithms.DataAnalysis.Experimental/sbart/dger.f @ 17185

Last change on this file since 17185 was 15457, checked in by gkronber, 7 years ago

#2789 added Finbarr O'Sullivan smoothing spline code

File size: 4.2 KB
Line 
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*
71*  Level 2 Blas routine.
72*
73*  -- Written on 22-October-1986.
74*     Jack Dongarra, Argonne National Lab.
75*     Jeremy Du Croz, Nag Central Office.
76*     Sven Hammarling, Nag Central Office.
77*     Richard Hanson, Sandia National Labs.
78*
79*
80*     .. Parameters ..
81      DOUBLE PRECISION ZERO
82      PARAMETER (ZERO=0.0D+0)
83*     ..
84*     .. Local Scalars ..
85      DOUBLE PRECISION TEMP
86      INTEGER I,INFO,IX,J,JY,KX
87*     ..
88*     .. External Subroutines ..
89      EXTERNAL XERBLA
90*     ..
91*     .. Intrinsic Functions ..
92      INTRINSIC MAX
93*     ..
94*
95*     Test the input parameters.
96*
97      INFO = 0
98      IF (M.LT.0) THEN
99          INFO = 1
100      ELSE IF (N.LT.0) THEN
101          INFO = 2
102      ELSE IF (INCX.EQ.0) THEN
103          INFO = 5
104      ELSE IF (INCY.EQ.0) THEN
105          INFO = 7
106      ELSE IF (LDA.LT.MAX(1,M)) THEN
107          INFO = 9
108      END IF
109      IF (INFO.NE.0) THEN
110          CALL XERBLA('DGER  ',INFO)
111          RETURN
112      END IF
113*
114*     Quick return if possible.
115*
116      IF ((M.EQ.0) .OR. (N.EQ.0) .OR. (ALPHA.EQ.ZERO)) RETURN
117*
118*     Start the operations. In this version the elements of A are
119*     accessed sequentially with one pass through A.
120*
121      IF (INCY.GT.0) THEN
122          JY = 1
123      ELSE
124          JY = 1 - (N-1)*INCY
125      END IF
126      IF (INCX.EQ.1) THEN
127          DO 20 J = 1,N
128              IF (Y(JY).NE.ZERO) THEN
129                  TEMP = ALPHA*Y(JY)
130                  DO 10 I = 1,M
131                      A(I,J) = A(I,J) + X(I)*TEMP
132   10             CONTINUE
133              END IF
134              JY = JY + INCY
135   20     CONTINUE
136      ELSE
137          IF (INCX.GT.0) THEN
138              KX = 1
139          ELSE
140              KX = 1 - (M-1)*INCX
141          END IF
142          DO 40 J = 1,N
143              IF (Y(JY).NE.ZERO) THEN
144                  TEMP = ALPHA*Y(JY)
145                  IX = KX
146                  DO 30 I = 1,M
147                      A(I,J) = A(I,J) + X(IX)*TEMP
148                      IX = IX + INCX
149   30             CONTINUE
150              END IF
151              JY = JY + INCY
152   40     CONTINUE
153      END IF
154*
155      RETURN
156*
157*     End of DGER  .
158*
159      END
Note: See TracBrowser for help on using the repository browser.