LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zhpr2.f
Go to the documentation of this file.
1 *> \brief \b ZHPR2
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 ZHPR2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
12 *
13 * .. Scalar Arguments ..
14 * COMPLEX*16 ALPHA
15 * INTEGER INCX,INCY,N
16 * CHARACTER UPLO
17 * ..
18 * .. Array Arguments ..
19 * COMPLEX*16 AP(*),X(*),Y(*)
20 * ..
21 *
22 *
23 *> \par Purpose:
24 * =============
25 *>
26 *> \verbatim
27 *>
28 *> ZHPR2 performs the hermitian rank 2 operation
29 *>
30 *> A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
31 *>
32 *> where alpha is a scalar, x and y are n element vectors and A is an
33 *> n by n hermitian 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 COMPLEX*16
63 *> On entry, ALPHA specifies the scalar alpha.
64 *> \endverbatim
65 *>
66 *> \param[in] X
67 *> \verbatim
68 *> X is COMPLEX*16 array of dimension at least
69 *> ( 1 + ( n - 1 )*abs( INCX ) ).
70 *> Before entry, the incremented array X must contain the n
71 *> element vector x.
72 *> \endverbatim
73 *>
74 *> \param[in] INCX
75 *> \verbatim
76 *> INCX is INTEGER
77 *> On entry, INCX specifies the increment for the elements of
78 *> X. INCX must not be zero.
79 *> \endverbatim
80 *>
81 *> \param[in] Y
82 *> \verbatim
83 *> Y is COMPLEX*16 array of dimension at least
84 *> ( 1 + ( n - 1 )*abs( INCY ) ).
85 *> Before entry, the incremented array Y must contain the n
86 *> element vector y.
87 *> \endverbatim
88 *>
89 *> \param[in] INCY
90 *> \verbatim
91 *> INCY is INTEGER
92 *> On entry, INCY specifies the increment for the elements of
93 *> Y. INCY must not be zero.
94 *> \endverbatim
95 *>
96 *> \param[in,out] AP
97 *> \verbatim
98 *> AP is COMPLEX*16 array of DIMENSION at least
99 *> ( ( n*( n + 1 ) )/2 ).
100 *> Before entry with UPLO = 'U' or 'u', the array AP must
101 *> contain the upper triangular part of the hermitian matrix
102 *> packed sequentially, column by column, so that AP( 1 )
103 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
104 *> and a( 2, 2 ) respectively, and so on. On exit, the array
105 *> AP is overwritten by the upper triangular part of the
106 *> updated matrix.
107 *> Before entry with UPLO = 'L' or 'l', the array AP must
108 *> contain the lower triangular part of the hermitian matrix
109 *> packed sequentially, column by column, so that AP( 1 )
110 *> contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
111 *> and a( 3, 1 ) respectively, and so on. On exit, the array
112 *> AP is overwritten by the lower triangular part of the
113 *> updated matrix.
114 *> Note that the imaginary parts of the diagonal elements need
115 *> not be set, they are assumed to be zero, and on exit they
116 *> are set to zero.
117 *> \endverbatim
118 *
119 * Authors:
120 * ========
121 *
122 *> \author Univ. of Tennessee
123 *> \author Univ. of California Berkeley
124 *> \author Univ. of Colorado Denver
125 *> \author NAG Ltd.
126 *
127 *> \date November 2011
128 *
129 *> \ingroup complex16_blas_level2
130 *
131 *> \par Further Details:
132 * =====================
133 *>
134 *> \verbatim
135 *>
136 *> Level 2 Blas routine.
137 *>
138 *> -- Written on 22-October-1986.
139 *> Jack Dongarra, Argonne National Lab.
140 *> Jeremy Du Croz, Nag Central Office.
141 *> Sven Hammarling, Nag Central Office.
142 *> Richard Hanson, Sandia National Labs.
143 *> \endverbatim
144 *>
145 * =====================================================================
146  SUBROUTINE zhpr2(UPLO,N,ALPHA,X,INCX,Y,INCY,AP)
147 *
148 * -- Reference BLAS level2 routine (version 3.4.0) --
149 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
150 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
151 * November 2011
152 *
153 * .. Scalar Arguments ..
154  COMPLEX*16 alpha
155  INTEGER incx,incy,n
156  CHARACTER uplo
157 * ..
158 * .. Array Arguments ..
159  COMPLEX*16 ap(*),x(*),y(*)
160 * ..
161 *
162 * =====================================================================
163 *
164 * .. Parameters ..
165  COMPLEX*16 zero
166  parameter(zero= (0.0d+0,0.0d+0))
167 * ..
168 * .. Local Scalars ..
169  COMPLEX*16 temp1,temp2
170  INTEGER i,info,ix,iy,j,jx,jy,k,kk,kx,ky
171 * ..
172 * .. External Functions ..
173  LOGICAL lsame
174  EXTERNAL lsame
175 * ..
176 * .. External Subroutines ..
177  EXTERNAL xerbla
178 * ..
179 * .. Intrinsic Functions ..
180  INTRINSIC dble,dconjg
181 * ..
182 *
183 * Test the input parameters.
184 *
185  info = 0
186  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
187  info = 1
188  ELSE IF (n.LT.0) THEN
189  info = 2
190  ELSE IF (incx.EQ.0) THEN
191  info = 5
192  ELSE IF (incy.EQ.0) THEN
193  info = 7
194  END IF
195  IF (info.NE.0) THEN
196  CALL xerbla('ZHPR2 ',info)
197  return
198  END IF
199 *
200 * Quick return if possible.
201 *
202  IF ((n.EQ.0) .OR. (alpha.EQ.zero)) return
203 *
204 * Set up the start points in X and Y if the increments are not both
205 * unity.
206 *
207  IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
208  IF (incx.GT.0) THEN
209  kx = 1
210  ELSE
211  kx = 1 - (n-1)*incx
212  END IF
213  IF (incy.GT.0) THEN
214  ky = 1
215  ELSE
216  ky = 1 - (n-1)*incy
217  END IF
218  jx = kx
219  jy = ky
220  END IF
221 *
222 * Start the operations. In this version the elements of the array AP
223 * are accessed sequentially with one pass through AP.
224 *
225  kk = 1
226  IF (lsame(uplo,'U')) THEN
227 *
228 * Form A when upper triangle is stored in AP.
229 *
230  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
231  DO 20 j = 1,n
232  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
233  temp1 = alpha*dconjg(y(j))
234  temp2 = dconjg(alpha*x(j))
235  k = kk
236  DO 10 i = 1,j - 1
237  ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
238  k = k + 1
239  10 continue
240  ap(kk+j-1) = dble(ap(kk+j-1)) +
241  + dble(x(j)*temp1+y(j)*temp2)
242  ELSE
243  ap(kk+j-1) = dble(ap(kk+j-1))
244  END IF
245  kk = kk + j
246  20 continue
247  ELSE
248  DO 40 j = 1,n
249  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
250  temp1 = alpha*dconjg(y(jy))
251  temp2 = dconjg(alpha*x(jx))
252  ix = kx
253  iy = ky
254  DO 30 k = kk,kk + j - 2
255  ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
256  ix = ix + incx
257  iy = iy + incy
258  30 continue
259  ap(kk+j-1) = dble(ap(kk+j-1)) +
260  + dble(x(jx)*temp1+y(jy)*temp2)
261  ELSE
262  ap(kk+j-1) = dble(ap(kk+j-1))
263  END IF
264  jx = jx + incx
265  jy = jy + incy
266  kk = kk + j
267  40 continue
268  END IF
269  ELSE
270 *
271 * Form A when lower triangle is stored in AP.
272 *
273  IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
274  DO 60 j = 1,n
275  IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
276  temp1 = alpha*dconjg(y(j))
277  temp2 = dconjg(alpha*x(j))
278  ap(kk) = dble(ap(kk)) +
279  + dble(x(j)*temp1+y(j)*temp2)
280  k = kk + 1
281  DO 50 i = j + 1,n
282  ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
283  k = k + 1
284  50 continue
285  ELSE
286  ap(kk) = dble(ap(kk))
287  END IF
288  kk = kk + n - j + 1
289  60 continue
290  ELSE
291  DO 80 j = 1,n
292  IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
293  temp1 = alpha*dconjg(y(jy))
294  temp2 = dconjg(alpha*x(jx))
295  ap(kk) = dble(ap(kk)) +
296  + dble(x(jx)*temp1+y(jy)*temp2)
297  ix = jx
298  iy = jy
299  DO 70 k = kk + 1,kk + n - j
300  ix = ix + incx
301  iy = iy + incy
302  ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
303  70 continue
304  ELSE
305  ap(kk) = dble(ap(kk))
306  END IF
307  jx = jx + incx
308  jy = jy + incy
309  kk = kk + n - j + 1
310  80 continue
311  END IF
312  END IF
313 *
314  return
315 *
316 * End of ZHPR2 .
317 *
318  END