← Back to branch summary

~ubuntu-branches/ubuntu/wily/julia/wily

« back to all changes in this revision

Viewing changes to deps/openlibm/slatec/chemv.f

  • Committer: Package Import Robot
  • Author(s): Sébastien Villemot
  • Date: 2013-01-16 12:29:42 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130116122942-x86e42akjq31repw
Tags: 0.0.0+20130107.gitd9656f41-1
* New upstream snashot
* No longer try to rebuild helpdb.jl.
   + debian/rules: remove helpdb.jl from build-arch rule
   + debian/control: move back python-sphinx to Build-Depends-Indep
* debian/copyright: reflect upstream changes
* Add Build-Conflicts on libatlas3-base (makes linalg tests fail)
* debian/rules: replace obsolete USE_DEBIAN makeflag by a list of
  USE_SYSTEM_* flags
* debian/rules: on non-x86 systems, use libm instead of openlibm
* dpkg-buildflags.patch: remove patch, applied upstream
* Refreshed other patches

Show diffs side-by-side

added added

removed removed

Lines of Context:
deps/openlibm/slatec/chemv.f
 
1
*DECK CHEMV
 
2
      SUBROUTINE CHEMV (UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
 
3
C***BEGIN PROLOGUE  CHEMV
 
4
C***PURPOSE  Multiply a complex vector by a complex Hermitian matrix.
 
5
C***LIBRARY   SLATEC (BLAS)
 
6
C***CATEGORY  D1B4
 
7
C***TYPE      COMPLEX (SHEMV-S, DHEMV-D, CHEMV-C)
 
8
C***KEYWORDS  LEVEL 2 BLAS, LINEAR ALGEBRA
 
9
C***AUTHOR  Dongarra, J. J., (ANL)
 
10
C           Du Croz, J., (NAG)
 
11
C           Hammarling, S., (NAG)
 
12
C           Hanson, R. J., (SNLA)
 
13
C***DESCRIPTION
 
14
C
 
15
C  CHEMV  performs the matrix-vector  operation
 
16
C
 
17
C     y := alpha*A*x + beta*y,
 
18
C
 
19
C  where alpha and beta are scalars, x and y are n element vectors and
 
20
C  A is an n by n hermitian matrix.
 
21
C
 
22
C  Parameters
 
23
C  ==========
 
24
C
 
25
C  UPLO   - CHARACTER*1.
 
26
C           On entry, UPLO specifies whether the upper or lower
 
27
C           triangular part of the array A is to be referenced as
 
28
C           follows:
 
29
C
 
30
C              UPLO = 'U' or 'u'   Only the upper triangular part of A
 
31
C                                  is to be referenced.
 
32
C
 
33
C              UPLO = 'L' or 'l'   Only the lower triangular part of A
 
34
C                                  is to be referenced.
 
35
C
 
36
C           Unchanged on exit.
 
37
C
 
38
C  N      - INTEGER.
 
39
C           On entry, N specifies the order of the matrix A.
 
40
C           N must be at least zero.
 
41
C           Unchanged on exit.
 
42
C
 
43
C  ALPHA  - COMPLEX         .
 
44
C           On entry, ALPHA specifies the scalar alpha.
 
45
C           Unchanged on exit.
 
46
C
 
47
C  A      - COMPLEX          array of DIMENSION ( LDA, n ).
 
48
C           Before entry with  UPLO = 'U' or 'u', the leading n by n
 
49
C           upper triangular part of the array A must contain the upper
 
50
C           triangular part of the hermitian matrix and the strictly
 
51
C           lower triangular part of A is not referenced.
 
52
C           Before entry with UPLO = 'L' or 'l', the leading n by n
 
53
C           lower triangular part of the array A must contain the lower
 
54
C           triangular part of the hermitian matrix and the strictly
 
55
C           upper triangular part of A is not referenced.
 
56
C           Note that the imaginary parts of the diagonal elements need
 
57
C           not be set and are assumed to be zero.
 
58
C           Unchanged on exit.
 
59
C
 
60
C  LDA    - INTEGER.
 
61
C           On entry, LDA specifies the first dimension of A as declared
 
62
C           in the calling (sub) program. LDA must be at least
 
63
C           max( 1, n ).
 
64
C           Unchanged on exit.
 
65
C
 
66
C  X      - COMPLEX          array of dimension at least
 
67
C           ( 1 + ( n - 1 )*abs( INCX ) ).
 
68
C           Before entry, the incremented array X must contain the n
 
69
C           element vector x.
 
70
C           Unchanged on exit.
 
71
C
 
72
C  INCX   - INTEGER.
 
73
C           On entry, INCX specifies the increment for the elements of
 
74
C           X. INCX must not be zero.
 
75
C           Unchanged on exit.
 
76
C
 
77
C  BETA   - COMPLEX         .
 
78
C           On entry, BETA specifies the scalar beta. When BETA is
 
79
C           supplied as zero then Y need not be set on input.
 
80
C           Unchanged on exit.
 
81
C
 
82
C  Y      - COMPLEX          array of dimension at least
 
83
C           ( 1 + ( n - 1 )*abs( INCY ) ).
 
84
C           Before entry, the incremented array Y must contain the n
 
85
C           element vector y. On exit, Y is overwritten by the updated
 
86
C           vector y.
 
87
C
 
88
C  INCY   - INTEGER.
 
89
C           On entry, INCY specifies the increment for the elements of
 
90
C           Y. INCY must not be zero.
 
91
C           Unchanged on exit.
 
92
C
 
93
C***REFERENCES  Dongarra, J. J., Du Croz, J., Hammarling, S., and
 
94
C                 Hanson, R. J.  An extended set of Fortran basic linear
 
95
C                 algebra subprograms.  ACM TOMS, Vol. 14, No. 1,
 
96
C                 pp. 1-17, March 1988.
 
97
C***ROUTINES CALLED  LSAME, XERBLA
 
98
C***REVISION HISTORY  (YYMMDD)
 
99
C   861022  DATE WRITTEN
 
100
C   910605  Modified to meet SLATEC prologue standards.  Only comment
 
101
C           lines were modified.  (BKS)
 
102
C***END PROLOGUE  CHEMV
 
103
C     .. Scalar Arguments ..
 
104
      COMPLEX            ALPHA, BETA
 
105
      INTEGER            INCX, INCY, LDA, N
 
106
      CHARACTER*1        UPLO
 
107
C     .. Array Arguments ..
 
108
      COMPLEX            A( LDA, * ), X( * ), Y( * )
 
109
C     .. Parameters ..
 
110
      COMPLEX            ONE
 
111
      PARAMETER        ( ONE  = ( 1.0E+0, 0.0E+0 ) )
 
112
      COMPLEX            ZERO
 
113
      PARAMETER        ( ZERO = ( 0.0E+0, 0.0E+0 ) )
 
114
C     .. Local Scalars ..
 
115
      COMPLEX            TEMP1, TEMP2
 
116
      INTEGER            I, INFO, IX, IY, J, JX, JY, KX, KY
 
117
C     .. External Functions ..
 
118
      LOGICAL            LSAME
 
119
      EXTERNAL           LSAME
 
120
C     .. External Subroutines ..
 
121
      EXTERNAL           XERBLA
 
122
C     .. Intrinsic Functions ..
 
123
      INTRINSIC          CONJG, MAX, REAL
 
124
C***FIRST EXECUTABLE STATEMENT  CHEMV
 
125
C
 
126
C     Test the input parameters.
 
127
C
 
128
      INFO = 0
 
129
      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
 
130
     $         .NOT.LSAME( UPLO, 'L' )      )THEN
 
131
         INFO = 1
 
132
      ELSE IF( N.LT.0 )THEN
 
133
         INFO = 2
 
134
      ELSE IF( LDA.LT.MAX( 1, N ) )THEN
 
135
         INFO = 5
 
136
      ELSE IF( INCX.EQ.0 )THEN
 
137
         INFO = 7
 
138
      ELSE IF( INCY.EQ.0 )THEN
 
139
         INFO = 10
 
140
      END IF
 
141
      IF( INFO.NE.0 )THEN
 
142
         CALL XERBLA( 'CHEMV ', INFO )
 
143
         RETURN
 
144
      END IF
 
145
C
 
146
C     Quick return if possible.
 
147
C
 
148
      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
 
149
     $   RETURN
 
150
C
 
151
C     Set up the start points in  X  and  Y.
 
152
C
 
153
      IF( INCX.GT.0 )THEN
 
154
         KX = 1
 
155
      ELSE
 
156
         KX = 1 - ( N - 1 )*INCX
 
157
      END IF
 
158
      IF( INCY.GT.0 )THEN
 
159
         KY = 1
 
160
      ELSE
 
161
         KY = 1 - ( N - 1 )*INCY
 
162
      END IF
 
163
C
 
164
C     Start the operations. In this version the elements of A are
 
165
C     accessed sequentially with one pass through the triangular part
 
166
C     of A.
 
167
C
 
168
C     First form  y := beta*y.
 
169
C
 
170
      IF( BETA.NE.ONE )THEN
 
171
         IF( INCY.EQ.1 )THEN
 
172
            IF( BETA.EQ.ZERO )THEN
 
173
               DO 10, I = 1, N
 
174
                  Y( I ) = ZERO
 
175
   10          CONTINUE
 
176
            ELSE
 
177
               DO 20, I = 1, N
 
178
                  Y( I ) = BETA*Y( I )
 
179
   20          CONTINUE
 
180
            END IF
 
181
         ELSE
 
182
            IY = KY
 
183
            IF( BETA.EQ.ZERO )THEN
 
184
               DO 30, I = 1, N
 
185
                  Y( IY ) = ZERO
 
186
                  IY      = IY   + INCY
 
187
   30          CONTINUE
 
188
            ELSE
 
189
               DO 40, I = 1, N
 
190
                  Y( IY ) = BETA*Y( IY )
 
191
                  IY      = IY           + INCY
 
192
   40          CONTINUE
 
193
            END IF
 
194
         END IF
 
195
      END IF
 
196
      IF( ALPHA.EQ.ZERO )
 
197
     $   RETURN
 
198
      IF( LSAME( UPLO, 'U' ) )THEN
 
199
C
 
200
C        Form  y  when A is stored in upper triangle.
 
201
C
 
202
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
 
203
            DO 60, J = 1, N
 
204
               TEMP1 = ALPHA*X( J )
 
205
               TEMP2 = ZERO
 
206
               DO 50, I = 1, J - 1
 
207
                  Y( I ) = Y( I ) + TEMP1*A( I, J )
 
208
                  TEMP2  = TEMP2  + CONJG( A( I, J ) )*X( I )
 
209
   50          CONTINUE
 
210
               Y( J ) = Y( J ) + TEMP1*REAL( A( J, J ) ) + ALPHA*TEMP2
 
211
   60       CONTINUE
 
212
         ELSE
 
213
            JX = KX
 
214
            JY = KY
 
215
            DO 80, J = 1, N
 
216
               TEMP1 = ALPHA*X( JX )
 
217
               TEMP2 = ZERO
 
218
               IX    = KX
 
219
               IY    = KY
 
220
               DO 70, I = 1, J - 1
 
221
                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
 
222
                  TEMP2   = TEMP2   + CONJG( A( I, J ) )*X( IX )
 
223
                  IX      = IX      + INCX
 
224
                  IY      = IY      + INCY
 
225
   70          CONTINUE
 
226
               Y( JY ) = Y( JY ) + TEMP1*REAL( A( J, J ) ) + ALPHA*TEMP2
 
227
               JX      = JX      + INCX
 
228
               JY      = JY      + INCY
 
229
   80       CONTINUE
 
230
         END IF
 
231
      ELSE
 
232
C
 
233
C        Form  y  when A is stored in lower triangle.
 
234
C
 
235
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
 
236
            DO 100, J = 1, N
 
237
               TEMP1  = ALPHA*X( J )
 
238
               TEMP2  = ZERO
 
239
               Y( J ) = Y( J ) + TEMP1*REAL( A( J, J ) )
 
240
               DO 90, I = J + 1, N
 
241
                  Y( I ) = Y( I ) + TEMP1*A( I, J )
 
242
                  TEMP2  = TEMP2  + CONJG( A( I, J ) )*X( I )
 
243
   90          CONTINUE
 
244
               Y( J ) = Y( J ) + ALPHA*TEMP2
 
245
  100       CONTINUE
 
246
         ELSE
 
247
            JX = KX
 
248
            JY = KY
 
249
            DO 120, J = 1, N
 
250
               TEMP1   = ALPHA*X( JX )
 
251
               TEMP2   = ZERO
 
252
               Y( JY ) = Y( JY ) + TEMP1*REAL( A( J, J ) )
 
253
               IX      = JX
 
254
               IY      = JY
 
255
               DO 110, I = J + 1, N
 
256
                  IX      = IX      + INCX
 
257
                  IY      = IY      + INCY
 
258
                  Y( IY ) = Y( IY ) + TEMP1*A( I, J )
 
259
                  TEMP2   = TEMP2   + CONJG( A( I, J ) )*X( IX )
 
260
  110          CONTINUE
 
261
               Y( JY ) = Y( JY ) + ALPHA*TEMP2
 
262
               JX      = JX      + INCX
 
263
               JY      = JY      + INCY
 
264
  120       CONTINUE
 
265
         END IF
 
266
      END IF
 
267
C
 
268
      RETURN
 
269
C
 
270
C     End of CHEMV .
 
271
C
 
272
      END