← Back to branch summary

~ubuntu-branches/ubuntu/trusty/nwchem/trusty-proposed

« back to all changes in this revision

Viewing changes to src/blas/single/sspmv.f

  • Committer: Package Import Robot
  • Author(s): Michael Banck, Daniel Leidert, Andreas Tille, Michael Banck
  • Date: 2013-07-04 12:14:55 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20130704121455-5tvsx2qabor3nrui
Tags: 6.3-1
http://bugs.debian.org/696361
* New upstream release.
* Fixes anisotropic properties (Closes: #696361).
* New features include:
  + Multi-reference coupled cluster (MRCC) approaches
  + Hybrid DFT calculations with short-range HF 
  + New density-functionals including Minnesota (M08, M11) and HSE hybrid
    functionals
  + X-ray absorption spectroscopy (XAS) with TDDFT
  + Analytical gradients for the COSMO solvation model
  + Transition densities from TDDFT 
  + DFT+U and Electron-Transfer (ET) methods for plane wave calculations
  + Exploitation of space group symmetry in plane wave geometry optimizations
  + Local density of states (LDOS) collective variable added to Metadynamics
  + Various new XC functionals added for plane wave calculations, including
    hybrid and range-corrected ones
  + Electric field gradients with relativistic corrections 
  + Nudged Elastic Band optimization method
  + Updated basis sets and ECPs 

[ Daniel Leidert ]
* debian/watch: Fixed.

[ Andreas Tille ]
* debian/upstream: References

[ Michael Banck ]
* debian/upstream (Name): New field.
* debian/patches/02_makefile_flags.patch: Refreshed.
* debian/patches/06_statfs_kfreebsd.patch: Likewise.
* debian/patches/07_ga_target_force_linux.patch: Likewise.
* debian/patches/05_avoid_inline_assembler.patch: Removed, no longer needed.
* debian/patches/09_backported_6.1.1_fixes.patch: Likewise.
* debian/control (Build-Depends): Added gfortran-4.7 and gcc-4.7.
* debian/patches/10_force_gcc-4.7.patch: New patch, explicitly sets
  gfortran-4.7 and gcc-4.7, fixes test suite hang with gcc-4.8 (Closes:
  #701328, #713262).
* debian/testsuite: Added tests for COSMO analytical gradients and MRCC.
* debian/rules (MRCC_METHODS): New variable, required to enable MRCC methods.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/blas/single/sspmv.f
1
 
      SUBROUTINE SSPMV ( UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY )
2
 
*
3
 
* $Id: sspmv.f 19695 2010-10-29 16:51:02Z d3y133 $
 
1
*> \brief \b SSPMV
 
2
*
 
3
*  =========== DOCUMENTATION ===========
 
4
*
 
5
* Online html documentation available at 
 
6
*            http://www.netlib.org/lapack/explore-html/ 
 
7
*
 
8
*  Definition:
 
9
*  ===========
 
10
*
 
11
*       SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
 
12
* 
 
13
*       .. Scalar Arguments ..
 
14
*       REAL ALPHA,BETA
 
15
*       INTEGER INCX,INCY,N
 
16
*       CHARACTER UPLO
 
17
*       ..
 
18
*       .. Array Arguments ..
 
19
*       REAL AP(*),X(*),Y(*)
 
20
*       ..
 
21
*  
 
22
*
 
23
*> \par Purpose:
 
24
*  =============
 
25
*>
 
26
*> \verbatim
 
27
*>
 
28
*> SSPMV  performs the matrix-vector operation
 
29
*>
 
30
*>    y := alpha*A*x + beta*y,
 
31
*>
 
32
*> where alpha and beta are scalars, x and y are n element vectors and
 
33
*> A is an n by n symmetric matrix, supplied in packed form.
 
34
*> \endverbatim
 
35
*
 
36
*  Arguments:
 
37
*  ==========
 
38
*
 
39
*> \param[in] UPLO
 
40
*> \verbatim
 
41
*>          UPLO is CHARACTER*1
 
42
*>           On entry, UPLO specifies whether the upper or lower
 
43
*>           triangular part of the matrix A is supplied in the packed
 
44
*>           array AP as follows:
 
45
*>
 
46
*>              UPLO = 'U' or 'u'   The upper triangular part of A is
 
47
*>                                  supplied in AP.
 
48
*>
 
49
*>              UPLO = 'L' or 'l'   The lower triangular part of A is
 
50
*>                                  supplied in AP.
 
51
*> \endverbatim
 
52
*>
 
53
*> \param[in] N
 
54
*> \verbatim
 
55
*>          N is INTEGER
 
56
*>           On entry, N specifies the order of the matrix A.
 
57
*>           N must be at least zero.
 
58
*> \endverbatim
 
59
*>
 
60
*> \param[in] ALPHA
 
61
*> \verbatim
 
62
*>          ALPHA is REAL
 
63
*>           On entry, ALPHA specifies the scalar alpha.
 
64
*> \endverbatim
 
65
*>
 
66
*> \param[in] AP
 
67
*> \verbatim
 
68
*>          AP is REAL array of DIMENSION at least
 
69
*>           ( ( n*( n + 1 ) )/2 ).
 
70
*>           Before entry with UPLO = 'U' or 'u', the array AP must
 
71
*>           contain the upper triangular part of the symmetric matrix
 
72
*>           packed sequentially, column by column, so that AP( 1 )
 
73
*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
 
74
*>           and a( 2, 2 ) respectively, and so on.
 
75
*>           Before entry with UPLO = 'L' or 'l', the array AP must
 
76
*>           contain the lower triangular part of the symmetric matrix
 
77
*>           packed sequentially, column by column, so that AP( 1 )
 
78
*>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
 
79
*>           and a( 3, 1 ) respectively, and so on.
 
80
*> \endverbatim
 
81
*>
 
82
*> \param[in] X
 
83
*> \verbatim
 
84
*>          X is REAL array of dimension at least
 
85
*>           ( 1 + ( n - 1 )*abs( INCX ) ).
 
86
*>           Before entry, the incremented array X must contain the n
 
87
*>           element vector x.
 
88
*> \endverbatim
 
89
*>
 
90
*> \param[in] INCX
 
91
*> \verbatim
 
92
*>          INCX is INTEGER
 
93
*>           On entry, INCX specifies the increment for the elements of
 
94
*>           X. INCX must not be zero.
 
95
*> \endverbatim
 
96
*>
 
97
*> \param[in] BETA
 
98
*> \verbatim
 
99
*>          BETA is REAL
 
100
*>           On entry, BETA specifies the scalar beta. When BETA is
 
101
*>           supplied as zero then Y need not be set on input.
 
102
*> \endverbatim
 
103
*>
 
104
*> \param[in,out] Y
 
105
*> \verbatim
 
106
*>          Y is REAL array of dimension at least
 
107
*>           ( 1 + ( n - 1 )*abs( INCY ) ).
 
108
*>           Before entry, the incremented array Y must contain the n
 
109
*>           element vector y. On exit, Y is overwritten by the updated
 
110
*>           vector y.
 
111
*> \endverbatim
 
112
*>
 
113
*> \param[in] INCY
 
114
*> \verbatim
 
115
*>          INCY is INTEGER
 
116
*>           On entry, INCY specifies the increment for the elements of
 
117
*>           Y. INCY must not be zero.
 
118
*> \endverbatim
 
119
*
 
120
*  Authors:
 
121
*  ========
 
122
*
 
123
*> \author Univ. of Tennessee 
 
124
*> \author Univ. of California Berkeley 
 
125
*> \author Univ. of Colorado Denver 
 
126
*> \author NAG Ltd. 
 
127
*
 
128
*> \date November 2011
 
129
*
 
130
*> \ingroup single_blas_level2
 
131
*
 
132
*> \par Further Details:
 
133
*  =====================
 
134
*>
 
135
*> \verbatim
 
136
*>
 
137
*>  Level 2 Blas routine.
 
138
*>  The vector and matrix arguments are not referenced when N = 0, or M = 0
 
139
*>
 
140
*>  -- Written on 22-October-1986.
 
141
*>     Jack Dongarra, Argonne National Lab.
 
142
*>     Jeremy Du Croz, Nag Central Office.
 
143
*>     Sven Hammarling, Nag Central Office.
 
144
*>     Richard Hanson, Sandia National Labs.
 
145
*> \endverbatim
 
146
*>
 
147
*  =====================================================================
 
148
      SUBROUTINE SSPMV(UPLO,N,ALPHA,AP,X,INCX,BETA,Y,INCY)
 
149
*
 
150
*  -- Reference BLAS level2 routine (version 3.4.0) --
 
151
*  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 
152
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 
153
*     November 2011
4
154
*
5
155
*     .. Scalar Arguments ..
6
 
      REAL               ALPHA, BETA
7
 
      INTEGER            INCX, INCY, N
8
 
      CHARACTER*1        UPLO
 
156
      REAL ALPHA,BETA
 
157
      INTEGER INCX,INCY,N
 
158
      CHARACTER UPLO
 
159
*     ..
9
160
*     .. Array Arguments ..
10
 
      REAL               AP( * ), X( * ), Y( * )
 
161
      REAL AP(*),X(*),Y(*)
11
162
*     ..
12
163
*
13
 
*  Purpose
14
 
*  =======
15
 
*
16
 
*  SSPMV  performs the matrix-vector operation
17
 
*
18
 
*     y := alpha*A*x + beta*y,
19
 
*
20
 
*  where alpha and beta are scalars, x and y are n element vectors and
21
 
*  A is an n by n symmetric matrix, supplied in packed form.
22
 
*
23
 
*  Parameters
24
 
*  ==========
25
 
*
26
 
*  UPLO   - CHARACTER*1.
27
 
*           On entry, UPLO specifies whether the upper or lower
28
 
*           triangular part of the matrix A is supplied in the packed
29
 
*           array AP as follows:
30
 
*
31
 
*              UPLO = 'U' or 'u'   The upper triangular part of A is
32
 
*                                  supplied in AP.
33
 
*
34
 
*              UPLO = 'L' or 'l'   The lower triangular part of A is
35
 
*                                  supplied in AP.
36
 
*
37
 
*           Unchanged on exit.
38
 
*
39
 
*  N      - INTEGER.
40
 
*           On entry, N specifies the order of the matrix A.
41
 
*           N must be at least zero.
42
 
*           Unchanged on exit.
43
 
*
44
 
*  ALPHA  - REAL            .
45
 
*           On entry, ALPHA specifies the scalar alpha.
46
 
*           Unchanged on exit.
47
 
*
48
 
*  AP     - REAL             array of DIMENSION at least
49
 
*           ( ( n*( n + 1 ) )/2 ).
50
 
*           Before entry with UPLO = 'U' or 'u', the array AP must
51
 
*           contain the upper triangular part of the symmetric matrix
52
 
*           packed sequentially, column by column, so that AP( 1 )
53
 
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
54
 
*           and a( 2, 2 ) respectively, and so on.
55
 
*           Before entry with UPLO = 'L' or 'l', the array AP must
56
 
*           contain the lower triangular part of the symmetric matrix
57
 
*           packed sequentially, column by column, so that AP( 1 )
58
 
*           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
59
 
*           and a( 3, 1 ) respectively, and so on.
60
 
*           Unchanged on exit.
61
 
*
62
 
*  X      - REAL             array of dimension at least
63
 
*           ( 1 + ( n - 1 )*abs( INCX ) ).
64
 
*           Before entry, the incremented array X must contain the n
65
 
*           element vector x.
66
 
*           Unchanged on exit.
67
 
*
68
 
*  INCX   - INTEGER.
69
 
*           On entry, INCX specifies the increment for the elements of
70
 
*           X. INCX must not be zero.
71
 
*           Unchanged on exit.
72
 
*
73
 
*  BETA   - REAL            .
74
 
*           On entry, BETA specifies the scalar beta. When BETA is
75
 
*           supplied as zero then Y need not be set on input.
76
 
*           Unchanged on exit.
77
 
*
78
 
*  Y      - REAL             array of dimension at least
79
 
*           ( 1 + ( n - 1 )*abs( INCY ) ).
80
 
*           Before entry, the incremented array Y must contain the n
81
 
*           element vector y. On exit, Y is overwritten by the updated
82
 
*           vector y.
83
 
*
84
 
*  INCY   - INTEGER.
85
 
*           On entry, INCY specifies the increment for the elements of
86
 
*           Y. INCY must not be zero.
87
 
*           Unchanged on exit.
88
 
*
89
 
*
90
 
*  Level 2 Blas routine.
91
 
*
92
 
*  -- Written on 22-October-1986.
93
 
*     Jack Dongarra, Argonne National Lab.
94
 
*     Jeremy Du Croz, Nag Central Office.
95
 
*     Sven Hammarling, Nag Central Office.
96
 
*     Richard Hanson, Sandia National Labs.
97
 
*
 
164
*  =====================================================================
98
165
*
99
166
*     .. Parameters ..
100
 
      REAL               ONE         , ZERO
101
 
      PARAMETER        ( ONE = 1.0E+0, ZERO = 0.0E+0 )
 
167
      REAL ONE,ZERO
 
168
      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
 
169
*     ..
102
170
*     .. Local Scalars ..
103
 
      REAL               TEMP1, TEMP2
104
 
      INTEGER            I, INFO, IX, IY, J, JX, JY, K, KK, KX, KY
 
171
      REAL TEMP1,TEMP2
 
172
      INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
 
173
*     ..
105
174
*     .. External Functions ..
106
 
      LOGICAL            LSAME
107
 
      EXTERNAL           LSAME
 
175
      LOGICAL LSAME
 
176
      EXTERNAL LSAME
 
177
*     ..
108
178
*     .. External Subroutines ..
109
 
      EXTERNAL           XERBLA
 
179
      EXTERNAL XERBLA
110
180
*     ..
111
 
*     .. Executable Statements ..
112
181
*
113
182
*     Test the input parameters.
114
183
*
115
184
      INFO = 0
116
 
      IF     ( .NOT.LSAME( UPLO, 'U' ).AND.
117
 
     $         .NOT.LSAME( UPLO, 'L' )      )THEN
118
 
         INFO = 1
119
 
      ELSE IF( N.LT.0 )THEN
120
 
         INFO = 2
121
 
      ELSE IF( INCX.EQ.0 )THEN
122
 
         INFO = 6
123
 
      ELSE IF( INCY.EQ.0 )THEN
124
 
         INFO = 9
 
185
      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
 
186
          INFO = 1
 
187
      ELSE IF (N.LT.0) THEN
 
188
          INFO = 2
 
189
      ELSE IF (INCX.EQ.0) THEN
 
190
          INFO = 6
 
191
      ELSE IF (INCY.EQ.0) THEN
 
192
          INFO = 9
125
193
      END IF
126
 
      IF( INFO.NE.0 )THEN
127
 
         CALL XERBLA( 'SSPMV ', INFO )
128
 
         RETURN
 
194
      IF (INFO.NE.0) THEN
 
195
          CALL XERBLA('SSPMV ',INFO)
 
196
          RETURN
129
197
      END IF
130
198
*
131
199
*     Quick return if possible.
132
200
*
133
 
      IF( ( N.EQ.0 ).OR.( ( ALPHA.EQ.ZERO ).AND.( BETA.EQ.ONE ) ) )
134
 
     $   RETURN
 
201
      IF ((N.EQ.0) .OR. ((ALPHA.EQ.ZERO).AND. (BETA.EQ.ONE))) RETURN
135
202
*
136
203
*     Set up the start points in  X  and  Y.
137
204
*
138
 
      IF( INCX.GT.0 )THEN
139
 
         KX = 1
 
205
      IF (INCX.GT.0) THEN
 
206
          KX = 1
140
207
      ELSE
141
 
         KX = 1 - ( N - 1 )*INCX
 
208
          KX = 1 - (N-1)*INCX
142
209
      END IF
143
 
      IF( INCY.GT.0 )THEN
144
 
         KY = 1
 
210
      IF (INCY.GT.0) THEN
 
211
          KY = 1
145
212
      ELSE
146
 
         KY = 1 - ( N - 1 )*INCY
 
213
          KY = 1 - (N-1)*INCY
147
214
      END IF
148
215
*
149
216
*     Start the operations. In this version the elements of the array AP
151
218
*
152
219
*     First form  y := beta*y.
153
220
*
154
 
      IF( BETA.NE.ONE )THEN
155
 
         IF( INCY.EQ.1 )THEN
156
 
            IF( BETA.EQ.ZERO )THEN
157
 
               DO 10, I = 1, N
158
 
                  Y( I ) = ZERO
159
 
   10          CONTINUE
160
 
            ELSE
161
 
               DO 20, I = 1, N
162
 
                  Y( I ) = BETA*Y( I )
163
 
   20          CONTINUE
164
 
            END IF
165
 
         ELSE
166
 
            IY = KY
167
 
            IF( BETA.EQ.ZERO )THEN
168
 
               DO 30, I = 1, N
169
 
                  Y( IY ) = ZERO
170
 
                  IY      = IY   + INCY
171
 
   30          CONTINUE
172
 
            ELSE
173
 
               DO 40, I = 1, N
174
 
                  Y( IY ) = BETA*Y( IY )
175
 
                  IY      = IY           + INCY
176
 
   40          CONTINUE
177
 
            END IF
178
 
         END IF
 
221
      IF (BETA.NE.ONE) THEN
 
222
          IF (INCY.EQ.1) THEN
 
223
              IF (BETA.EQ.ZERO) THEN
 
224
                  DO 10 I = 1,N
 
225
                      Y(I) = ZERO
 
226
   10             CONTINUE
 
227
              ELSE
 
228
                  DO 20 I = 1,N
 
229
                      Y(I) = BETA*Y(I)
 
230
   20             CONTINUE
 
231
              END IF
 
232
          ELSE
 
233
              IY = KY
 
234
              IF (BETA.EQ.ZERO) THEN
 
235
                  DO 30 I = 1,N
 
236
                      Y(IY) = ZERO
 
237
                      IY = IY + INCY
 
238
   30             CONTINUE
 
239
              ELSE
 
240
                  DO 40 I = 1,N
 
241
                      Y(IY) = BETA*Y(IY)
 
242
                      IY = IY + INCY
 
243
   40             CONTINUE
 
244
              END IF
 
245
          END IF
179
246
      END IF
180
 
      IF( ALPHA.EQ.ZERO )
181
 
     $   RETURN
 
247
      IF (ALPHA.EQ.ZERO) RETURN
182
248
      KK = 1
183
 
      IF( LSAME( UPLO, 'U' ) )THEN
 
249
      IF (LSAME(UPLO,'U')) THEN
184
250
*
185
251
*        Form  y  when AP contains the upper triangle.
186
252
*
187
 
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
188
 
            DO 60, J = 1, N
189
 
               TEMP1 = ALPHA*X( J )
190
 
               TEMP2 = ZERO
191
 
               K     = KK
192
 
               DO 50, I = 1, J - 1
193
 
                  Y( I ) = Y( I ) + TEMP1*AP( K )
194
 
                  TEMP2  = TEMP2  + AP( K )*X( I )
195
 
                  K      = K      + 1
196
 
   50          CONTINUE
197
 
               Y( J ) = Y( J ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2
198
 
               KK     = KK     + J
199
 
   60       CONTINUE
200
 
         ELSE
201
 
            JX = KX
202
 
            JY = KY
203
 
            DO 80, J = 1, N
204
 
               TEMP1 = ALPHA*X( JX )
205
 
               TEMP2 = ZERO
206
 
               IX    = KX
207
 
               IY    = KY
208
 
               DO 70, K = KK, KK + J - 2
209
 
                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
210
 
                  TEMP2   = TEMP2   + AP( K )*X( IX )
211
 
                  IX      = IX      + INCX
212
 
                  IY      = IY      + INCY
213
 
   70          CONTINUE
214
 
               Y( JY ) = Y( JY ) + TEMP1*AP( KK + J - 1 ) + ALPHA*TEMP2
215
 
               JX      = JX      + INCX
216
 
               JY      = JY      + INCY
217
 
               KK      = KK      + J
218
 
   80       CONTINUE
219
 
         END IF
 
253
          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
 
254
              DO 60 J = 1,N
 
255
                  TEMP1 = ALPHA*X(J)
 
256
                  TEMP2 = ZERO
 
257
                  K = KK
 
258
                  DO 50 I = 1,J - 1
 
259
                      Y(I) = Y(I) + TEMP1*AP(K)
 
260
                      TEMP2 = TEMP2 + AP(K)*X(I)
 
261
                      K = K + 1
 
262
   50             CONTINUE
 
263
                  Y(J) = Y(J) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
 
264
                  KK = KK + J
 
265
   60         CONTINUE
 
266
          ELSE
 
267
              JX = KX
 
268
              JY = KY
 
269
              DO 80 J = 1,N
 
270
                  TEMP1 = ALPHA*X(JX)
 
271
                  TEMP2 = ZERO
 
272
                  IX = KX
 
273
                  IY = KY
 
274
                  DO 70 K = KK,KK + J - 2
 
275
                      Y(IY) = Y(IY) + TEMP1*AP(K)
 
276
                      TEMP2 = TEMP2 + AP(K)*X(IX)
 
277
                      IX = IX + INCX
 
278
                      IY = IY + INCY
 
279
   70             CONTINUE
 
280
                  Y(JY) = Y(JY) + TEMP1*AP(KK+J-1) + ALPHA*TEMP2
 
281
                  JX = JX + INCX
 
282
                  JY = JY + INCY
 
283
                  KK = KK + J
 
284
   80         CONTINUE
 
285
          END IF
220
286
      ELSE
221
287
*
222
288
*        Form  y  when AP contains the lower triangle.
223
289
*
224
 
         IF( ( INCX.EQ.1 ).AND.( INCY.EQ.1 ) )THEN
225
 
            DO 100, J = 1, N
226
 
               TEMP1  = ALPHA*X( J )
227
 
               TEMP2  = ZERO
228
 
               Y( J ) = Y( J )       + TEMP1*AP( KK )
229
 
               K      = KK           + 1
230
 
               DO 90, I = J + 1, N
231
 
                  Y( I ) = Y( I ) + TEMP1*AP( K )
232
 
                  TEMP2  = TEMP2  + AP( K )*X( I )
233
 
                  K      = K      + 1
234
 
   90          CONTINUE
235
 
               Y( J ) = Y( J ) + ALPHA*TEMP2
236
 
               KK     = KK     + ( N - J + 1 )
237
 
  100       CONTINUE
238
 
         ELSE
239
 
            JX = KX
240
 
            JY = KY
241
 
            DO 120, J = 1, N
242
 
               TEMP1   = ALPHA*X( JX )
243
 
               TEMP2   = ZERO
244
 
               Y( JY ) = Y( JY )       + TEMP1*AP( KK )
245
 
               IX      = JX
246
 
               IY      = JY
247
 
               DO 110, K = KK + 1, KK + N - J
248
 
                  IX      = IX      + INCX
249
 
                  IY      = IY      + INCY
250
 
                  Y( IY ) = Y( IY ) + TEMP1*AP( K )
251
 
                  TEMP2   = TEMP2   + AP( K )*X( IX )
252
 
  110          CONTINUE
253
 
               Y( JY ) = Y( JY ) + ALPHA*TEMP2
254
 
               JX      = JX      + INCX
255
 
               JY      = JY      + INCY
256
 
               KK      = KK      + ( N - J + 1 )
257
 
  120       CONTINUE
258
 
         END IF
 
290
          IF ((INCX.EQ.1) .AND. (INCY.EQ.1)) THEN
 
291
              DO 100 J = 1,N
 
292
                  TEMP1 = ALPHA*X(J)
 
293
                  TEMP2 = ZERO
 
294
                  Y(J) = Y(J) + TEMP1*AP(KK)
 
295
                  K = KK + 1
 
296
                  DO 90 I = J + 1,N
 
297
                      Y(I) = Y(I) + TEMP1*AP(K)
 
298
                      TEMP2 = TEMP2 + AP(K)*X(I)
 
299
                      K = K + 1
 
300
   90             CONTINUE
 
301
                  Y(J) = Y(J) + ALPHA*TEMP2
 
302
                  KK = KK + (N-J+1)
 
303
  100         CONTINUE
 
304
          ELSE
 
305
              JX = KX
 
306
              JY = KY
 
307
              DO 120 J = 1,N
 
308
                  TEMP1 = ALPHA*X(JX)
 
309
                  TEMP2 = ZERO
 
310
                  Y(JY) = Y(JY) + TEMP1*AP(KK)
 
311
                  IX = JX
 
312
                  IY = JY
 
313
                  DO 110 K = KK + 1,KK + N - J
 
314
                      IX = IX + INCX
 
315
                      IY = IY + INCY
 
316
                      Y(IY) = Y(IY) + TEMP1*AP(K)
 
317
                      TEMP2 = TEMP2 + AP(K)*X(IX)
 
318
  110             CONTINUE
 
319
                  Y(JY) = Y(JY) + ALPHA*TEMP2
 
320
                  JX = JX + INCX
 
321
                  JY = JY + INCY
 
322
                  KK = KK + (N-J+1)
 
323
  120         CONTINUE
 
324
          END IF
259
325
      END IF
260
326
*
261
327
      RETURN