Statistiques
| Révision :

root / src / blas / dger.f @ 5

Historique | Voir | Annoter | Télécharger (4,16 ko)

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