OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
complex16
Reference BLAS » Level2

Functions

subroutine zgbmv (trans, m, n, kl, ku, alpha, a, lda, x, incx, beta, y, incy)
 ZGBMV
subroutine zgemv (trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
 ZGEMV
subroutine zgerc (m, n, alpha, x, incx, y, incy, a, lda)
 ZGERC
subroutine zgeru (m, n, alpha, x, incx, y, incy, a, lda)
 ZGERU
subroutine zhbmv (uplo, n, k, alpha, a, lda, x, incx, beta, y, incy)
 ZHBMV
subroutine zhemv (uplo, n, alpha, a, lda, x, incx, beta, y, incy)
 ZHEMV
subroutine zher (uplo, n, alpha, x, incx, a, lda)
 ZHER
subroutine zher2 (uplo, n, alpha, x, incx, y, incy, a, lda)
 ZHER2
subroutine zhpmv (uplo, n, alpha, ap, x, incx, beta, y, incy)
 ZHPMV
subroutine zhpr (uplo, n, alpha, x, incx, ap)
 ZHPR
subroutine zhpr2 (uplo, n, alpha, x, incx, y, incy, ap)
 ZHPR2
subroutine ztbmv (uplo, trans, diag, n, k, a, lda, x, incx)
 ZTBMV
subroutine ztbsv (uplo, trans, diag, n, k, a, lda, x, incx)
 ZTBSV
subroutine ztpmv (uplo, trans, diag, n, ap, x, incx)
 ZTPMV
subroutine ztpsv (uplo, trans, diag, n, ap, x, incx)
 ZTPSV
subroutine ztrmv (uplo, trans, diag, n, a, lda, x, incx)
 ZTRMV
subroutine ztrsv (uplo, trans, diag, n, a, lda, x, incx)
 ZTRSV

Detailed Description

This is the group of complex16 LEVEL 2 BLAS routines.

Function Documentation

◆ zgbmv()

subroutine zgbmv ( character trans,
integer m,
integer n,
integer kl,
integer ku,
complex*16 alpha,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx,
complex*16 beta,
complex*16, dimension(*) y,
integer incy )

ZGBMV

Purpose:
!>
!> ZGBMV  performs one of the matrix-vector operations
!>
!>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,   or
!>
!>    y := alpha*A**H*x + beta*y,
!>
!> where alpha and beta are scalars, x and y are vectors and A is an
!> m by n band matrix, with kl sub-diagonals and ku super-diagonals.
!>
Parameters
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the operation to be performed as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
!>
!>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
!>
!>              TRANS = 'C' or 'c'   y := alpha*A**H*x + beta*y.
!>
[in]M
!>          M is INTEGER
!>           On entry, M specifies the number of rows of the matrix A.
!>           M must be at least zero.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the number of columns of the matrix A.
!>           N must be at least zero.
!>
[in]KL
!>          KL is INTEGER
!>           On entry, KL specifies the number of sub-diagonals of the
!>           matrix A. KL must satisfy  0 .le. KL.
!>
[in]KU
!>          KU is INTEGER
!>           On entry, KU specifies the number of super-diagonals of the
!>           matrix A. KU must satisfy  0 .le. KU.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry, the leading ( kl + ku + 1 ) by n part of the
!>           array A must contain the matrix of coefficients, supplied
!>           column by column, with the leading diagonal of the matrix in
!>           row ( ku + 1 ) of the array, the first super-diagonal
!>           starting at position 2 in row ku, the first sub-diagonal
!>           starting at position 1 in row ( ku + 2 ), and so on.
!>           Elements in the array A that do not correspond to elements
!>           in the band matrix (such as the top left ku by ku triangle)
!>           are not referenced.
!>           The following program segment will transfer a band matrix
!>           from conventional full matrix storage to band storage:
!>
!>                 DO 20, J = 1, N
!>                    K = KU + 1 - J
!>                    DO 10, I = MAX( 1, J - KU ), MIN( M, J + KL )
!>                       A( K + I, J ) = matrix( I, J )
!>              10    CONTINUE
!>              20 CONTINUE
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           ( kl + ku + 1 ).
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
!>           and at least
!>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
!>           Before entry, the incremented array X must contain the
!>           vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]BETA
!>          BETA is COMPLEX*16
!>           On entry, BETA specifies the scalar beta. When BETA is
!>           supplied as zero then Y need not be set on input.
!>
[in,out]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
!>           and at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
!>           Before entry, the incremented array Y must contain the
!>           vector y. On exit, Y is overwritten by the updated vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 186 of file zgbmv.f.

187*
188* -- Reference BLAS level2 routine --
189* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
190* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
191*
192* .. Scalar Arguments ..
193 COMPLEX*16 ALPHA,BETA
194 INTEGER INCX,INCY,KL,KU,LDA,M,N
195 CHARACTER TRANS
196* ..
197* .. Array Arguments ..
198 COMPLEX*16 A(LDA,*),X(*),Y(*)
199* ..
200*
201* =====================================================================
202*
203* .. Parameters ..
204 COMPLEX*16 ONE
205 parameter(one= (1.0d+0,0.0d+0))
206 COMPLEX*16 ZERO
207 parameter(zero= (0.0d+0,0.0d+0))
208* ..
209* .. Local Scalars ..
210 COMPLEX*16 TEMP
211 INTEGER I,INFO,IX,IY,J,JX,JY,K,KUP1,KX,KY,LENX,LENY
212 LOGICAL NOCONJ
213* ..
214* .. External Functions ..
215 LOGICAL LSAME
216 EXTERNAL lsame
217* ..
218* .. External Subroutines ..
219 EXTERNAL xerbla
220* ..
221* .. Intrinsic Functions ..
222 INTRINSIC dconjg,max,min
223* ..
224*
225* Test the input parameters.
226*
227 info = 0
228 IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
229 + .NOT.lsame(trans,'C')) THEN
230 info = 1
231 ELSE IF (m.LT.0) THEN
232 info = 2
233 ELSE IF (n.LT.0) THEN
234 info = 3
235 ELSE IF (kl.LT.0) THEN
236 info = 4
237 ELSE IF (ku.LT.0) THEN
238 info = 5
239 ELSE IF (lda.LT. (kl+ku+1)) THEN
240 info = 8
241 ELSE IF (incx.EQ.0) THEN
242 info = 10
243 ELSE IF (incy.EQ.0) THEN
244 info = 13
245 END IF
246 IF (info.NE.0) THEN
247 CALL xerbla('ZGBMV ',info)
248 RETURN
249 END IF
250*
251* Quick return if possible.
252*
253 IF ((m.EQ.0) .OR. (n.EQ.0) .OR.
254 + ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
255*
256 noconj = lsame(trans,'T')
257*
258* Set LENX and LENY, the lengths of the vectors x and y, and set
259* up the start points in X and Y.
260*
261 IF (lsame(trans,'N')) THEN
262 lenx = n
263 leny = m
264 ELSE
265 lenx = m
266 leny = n
267 END IF
268 IF (incx.GT.0) THEN
269 kx = 1
270 ELSE
271 kx = 1 - (lenx-1)*incx
272 END IF
273 IF (incy.GT.0) THEN
274 ky = 1
275 ELSE
276 ky = 1 - (leny-1)*incy
277 END IF
278*
279* Start the operations. In this version the elements of A are
280* accessed sequentially with one pass through the band part of A.
281*
282* First form y := beta*y.
283*
284 IF (beta.NE.one) THEN
285 IF (incy.EQ.1) THEN
286 IF (beta.EQ.zero) THEN
287 DO 10 i = 1,leny
288 y(i) = zero
289 10 CONTINUE
290 ELSE
291 DO 20 i = 1,leny
292 y(i) = beta*y(i)
293 20 CONTINUE
294 END IF
295 ELSE
296 iy = ky
297 IF (beta.EQ.zero) THEN
298 DO 30 i = 1,leny
299 y(iy) = zero
300 iy = iy + incy
301 30 CONTINUE
302 ELSE
303 DO 40 i = 1,leny
304 y(iy) = beta*y(iy)
305 iy = iy + incy
306 40 CONTINUE
307 END IF
308 END IF
309 END IF
310 IF (alpha.EQ.zero) RETURN
311 kup1 = ku + 1
312 IF (lsame(trans,'N')) THEN
313*
314* Form y := alpha*A*x + y.
315*
316 jx = kx
317 IF (incy.EQ.1) THEN
318 DO 60 j = 1,n
319 temp = alpha*x(jx)
320 k = kup1 - j
321 DO 50 i = max(1,j-ku),min(m,j+kl)
322 y(i) = y(i) + temp*a(k+i,j)
323 50 CONTINUE
324 jx = jx + incx
325 60 CONTINUE
326 ELSE
327 DO 80 j = 1,n
328 temp = alpha*x(jx)
329 iy = ky
330 k = kup1 - j
331 DO 70 i = max(1,j-ku),min(m,j+kl)
332 y(iy) = y(iy) + temp*a(k+i,j)
333 iy = iy + incy
334 70 CONTINUE
335 jx = jx + incx
336 IF (j.GT.ku) ky = ky + incy
337 80 CONTINUE
338 END IF
339 ELSE
340*
341* Form y := alpha*A**T*x + y or y := alpha*A**H*x + y.
342*
343 jy = ky
344 IF (incx.EQ.1) THEN
345 DO 110 j = 1,n
346 temp = zero
347 k = kup1 - j
348 IF (noconj) THEN
349 DO 90 i = max(1,j-ku),min(m,j+kl)
350 temp = temp + a(k+i,j)*x(i)
351 90 CONTINUE
352 ELSE
353 DO 100 i = max(1,j-ku),min(m,j+kl)
354 temp = temp + dconjg(a(k+i,j))*x(i)
355 100 CONTINUE
356 END IF
357 y(jy) = y(jy) + alpha*temp
358 jy = jy + incy
359 110 CONTINUE
360 ELSE
361 DO 140 j = 1,n
362 temp = zero
363 ix = kx
364 k = kup1 - j
365 IF (noconj) THEN
366 DO 120 i = max(1,j-ku),min(m,j+kl)
367 temp = temp + a(k+i,j)*x(ix)
368 ix = ix + incx
369 120 CONTINUE
370 ELSE
371 DO 130 i = max(1,j-ku),min(m,j+kl)
372 temp = temp + dconjg(a(k+i,j))*x(ix)
373 ix = ix + incx
374 130 CONTINUE
375 END IF
376 y(jy) = y(jy) + alpha*temp
377 jy = jy + incy
378 IF (j.GT.ku) kx = kx + incx
379 140 CONTINUE
380 END IF
381 END IF
382*
383 RETURN
384*
385* End of ZGBMV
386*
alpha
#define alpha
Definition eval.h:35
xerbla
subroutine xerbla(srname, info)
XERBLA
Definition xerbla.f:60
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21

◆ zgemv()

subroutine zgemv ( character trans,
integer m,
integer n,
complex*16 alpha,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx,
complex*16 beta,
complex*16, dimension(*) y,
integer incy )

ZGEMV

Purpose:
!>
!> ZGEMV  performs one of the matrix-vector operations
!>
!>    y := alpha*A*x + beta*y,   or   y := alpha*A**T*x + beta*y,   or
!>
!>    y := alpha*A**H*x + beta*y,
!>
!> where alpha and beta are scalars, x and y are vectors and A is an
!> m by n matrix.
!>
Parameters
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the operation to be performed as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   y := alpha*A*x + beta*y.
!>
!>              TRANS = 'T' or 't'   y := alpha*A**T*x + beta*y.
!>
!>              TRANS = 'C' or 'c'   y := alpha*A**H*x + beta*y.
!>
[in]M
!>          M is INTEGER
!>           On entry, M specifies the number of rows of the matrix A.
!>           M must be at least zero.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the number of columns of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry, the leading m by n part of the array A must
!>           contain the matrix of coefficients.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, m ).
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n'
!>           and at least
!>           ( 1 + ( m - 1 )*abs( INCX ) ) otherwise.
!>           Before entry, the incremented array X must contain the
!>           vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]BETA
!>          BETA is COMPLEX*16
!>           On entry, BETA specifies the scalar beta. When BETA is
!>           supplied as zero then Y need not be set on input.
!>
[in,out]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n'
!>           and at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ) otherwise.
!>           Before entry with BETA non-zero, the incremented array Y
!>           must contain the vector y. On exit, Y is overwritten by the
!>           updated vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 157 of file zgemv.f.

158*
159* -- Reference BLAS level2 routine --
160* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
161* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
162*
163* .. Scalar Arguments ..
164 COMPLEX*16 ALPHA,BETA
165 INTEGER INCX,INCY,LDA,M,N
166 CHARACTER TRANS
167* ..
168* .. Array Arguments ..
169 COMPLEX*16 A(LDA,*),X(*),Y(*)
170* ..
171*
172* =====================================================================
173*
174* .. Parameters ..
175 COMPLEX*16 ONE
176 parameter(one= (1.0d+0,0.0d+0))
177 COMPLEX*16 ZERO
178 parameter(zero= (0.0d+0,0.0d+0))
179* ..
180* .. Local Scalars ..
181 COMPLEX*16 TEMP
182 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY,LENX,LENY
183 LOGICAL NOCONJ
184* ..
185* .. External Functions ..
186 LOGICAL LSAME
187 EXTERNAL lsame
188* ..
189* .. External Subroutines ..
190 EXTERNAL xerbla
191* ..
192* .. Intrinsic Functions ..
193 INTRINSIC dconjg,max
194* ..
195*
196* Test the input parameters.
197*
198 info = 0
199 IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
200 + .NOT.lsame(trans,'C')) THEN
201 info = 1
202 ELSE IF (m.LT.0) THEN
203 info = 2
204 ELSE IF (n.LT.0) THEN
205 info = 3
206 ELSE IF (lda.LT.max(1,m)) THEN
207 info = 6
208 ELSE IF (incx.EQ.0) THEN
209 info = 8
210 ELSE IF (incy.EQ.0) THEN
211 info = 11
212 END IF
213 IF (info.NE.0) THEN
214 CALL xerbla('ZGEMV ',info)
215 RETURN
216 END IF
217*
218* Quick return if possible.
219*
220 IF ((m.EQ.0) .OR. (n.EQ.0) .OR.
221 + ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
222*
223 noconj = lsame(trans,'T')
224*
225* Set LENX and LENY, the lengths of the vectors x and y, and set
226* up the start points in X and Y.
227*
228 IF (lsame(trans,'N')) THEN
229 lenx = n
230 leny = m
231 ELSE
232 lenx = m
233 leny = n
234 END IF
235 IF (incx.GT.0) THEN
236 kx = 1
237 ELSE
238 kx = 1 - (lenx-1)*incx
239 END IF
240 IF (incy.GT.0) THEN
241 ky = 1
242 ELSE
243 ky = 1 - (leny-1)*incy
244 END IF
245*
246* Start the operations. In this version the elements of A are
247* accessed sequentially with one pass through A.
248*
249* First form y := beta*y.
250*
251 IF (beta.NE.one) THEN
252 IF (incy.EQ.1) THEN
253 IF (beta.EQ.zero) THEN
254 DO 10 i = 1,leny
255 y(i) = zero
256 10 CONTINUE
257 ELSE
258 DO 20 i = 1,leny
259 y(i) = beta*y(i)
260 20 CONTINUE
261 END IF
262 ELSE
263 iy = ky
264 IF (beta.EQ.zero) THEN
265 DO 30 i = 1,leny
266 y(iy) = zero
267 iy = iy + incy
268 30 CONTINUE
269 ELSE
270 DO 40 i = 1,leny
271 y(iy) = beta*y(iy)
272 iy = iy + incy
273 40 CONTINUE
274 END IF
275 END IF
276 END IF
277 IF (alpha.EQ.zero) RETURN
278 IF (lsame(trans,'N')) THEN
279*
280* Form y := alpha*A*x + y.
281*
282 jx = kx
283 IF (incy.EQ.1) THEN
284 DO 60 j = 1,n
285 temp = alpha*x(jx)
286 DO 50 i = 1,m
287 y(i) = y(i) + temp*a(i,j)
288 50 CONTINUE
289 jx = jx + incx
290 60 CONTINUE
291 ELSE
292 DO 80 j = 1,n
293 temp = alpha*x(jx)
294 iy = ky
295 DO 70 i = 1,m
296 y(iy) = y(iy) + temp*a(i,j)
297 iy = iy + incy
298 70 CONTINUE
299 jx = jx + incx
300 80 CONTINUE
301 END IF
302 ELSE
303*
304* Form y := alpha*A**T*x + y or y := alpha*A**H*x + y.
305*
306 jy = ky
307 IF (incx.EQ.1) THEN
308 DO 110 j = 1,n
309 temp = zero
310 IF (noconj) THEN
311 DO 90 i = 1,m
312 temp = temp + a(i,j)*x(i)
313 90 CONTINUE
314 ELSE
315 DO 100 i = 1,m
316 temp = temp + dconjg(a(i,j))*x(i)
317 100 CONTINUE
318 END IF
319 y(jy) = y(jy) + alpha*temp
320 jy = jy + incy
321 110 CONTINUE
322 ELSE
323 DO 140 j = 1,n
324 temp = zero
325 ix = kx
326 IF (noconj) THEN
327 DO 120 i = 1,m
328 temp = temp + a(i,j)*x(ix)
329 ix = ix + incx
330 120 CONTINUE
331 ELSE
332 DO 130 i = 1,m
333 temp = temp + dconjg(a(i,j))*x(ix)
334 ix = ix + incx
335 130 CONTINUE
336 END IF
337 y(jy) = y(jy) + alpha*temp
338 jy = jy + incy
339 140 CONTINUE
340 END IF
341 END IF
342*
343 RETURN
344*
345* End of ZGEMV
346*

◆ zgerc()

subroutine zgerc ( integer m,
integer n,
complex*16 alpha,
complex*16, dimension(*) x,
integer incx,
complex*16, dimension(*) y,
integer incy,
complex*16, dimension(lda,*) a,
integer lda )

ZGERC

Purpose:
!>
!> ZGERC  performs the rank 1 operation
!>
!>    A := alpha*x*y**H + A,
!>
!> where alpha is a scalar, x is an m element vector, y is an n element
!> vector and A is an m by n matrix.
!>
Parameters
[in]M
!>          M is INTEGER
!>           On entry, M specifies the number of rows of the matrix A.
!>           M must be at least zero.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the number of columns of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( m - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the m
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ).
!>           Before entry, the incremented array Y must contain the n
!>           element vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
[in,out]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry, the leading m by n part of the array A must
!>           contain the matrix of coefficients. On exit, A is
!>           overwritten by the updated matrix.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, m ).
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 129 of file zgerc.f.

130*
131* -- Reference BLAS level2 routine --
132* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
133* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134*
135* .. Scalar Arguments ..
136 COMPLEX*16 ALPHA
137 INTEGER INCX,INCY,LDA,M,N
138* ..
139* .. Array Arguments ..
140 COMPLEX*16 A(LDA,*),X(*),Y(*)
141* ..
142*
143* =====================================================================
144*
145* .. Parameters ..
146 COMPLEX*16 ZERO
147 parameter(zero= (0.0d+0,0.0d+0))
148* ..
149* .. Local Scalars ..
150 COMPLEX*16 TEMP
151 INTEGER I,INFO,IX,J,JY,KX
152* ..
153* .. External Subroutines ..
154 EXTERNAL xerbla
155* ..
156* .. Intrinsic Functions ..
157 INTRINSIC dconjg,max
158* ..
159*
160* Test the input parameters.
161*
162 info = 0
163 IF (m.LT.0) THEN
164 info = 1
165 ELSE IF (n.LT.0) THEN
166 info = 2
167 ELSE IF (incx.EQ.0) THEN
168 info = 5
169 ELSE IF (incy.EQ.0) THEN
170 info = 7
171 ELSE IF (lda.LT.max(1,m)) THEN
172 info = 9
173 END IF
174 IF (info.NE.0) THEN
175 CALL xerbla('ZGERC ',info)
176 RETURN
177 END IF
178*
179* Quick return if possible.
180*
181 IF ((m.EQ.0) .OR. (n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
182*
183* Start the operations. In this version the elements of A are
184* accessed sequentially with one pass through A.
185*
186 IF (incy.GT.0) THEN
187 jy = 1
188 ELSE
189 jy = 1 - (n-1)*incy
190 END IF
191 IF (incx.EQ.1) THEN
192 DO 20 j = 1,n
193 IF (y(jy).NE.zero) THEN
194 temp = alpha*dconjg(y(jy))
195 DO 10 i = 1,m
196 a(i,j) = a(i,j) + x(i)*temp
197 10 CONTINUE
198 END IF
199 jy = jy + incy
200 20 CONTINUE
201 ELSE
202 IF (incx.GT.0) THEN
203 kx = 1
204 ELSE
205 kx = 1 - (m-1)*incx
206 END IF
207 DO 40 j = 1,n
208 IF (y(jy).NE.zero) THEN
209 temp = alpha*dconjg(y(jy))
210 ix = kx
211 DO 30 i = 1,m
212 a(i,j) = a(i,j) + x(ix)*temp
213 ix = ix + incx
214 30 CONTINUE
215 END IF
216 jy = jy + incy
217 40 CONTINUE
218 END IF
219*
220 RETURN
221*
222* End of ZGERC
223*

◆ zgeru()

subroutine zgeru ( integer m,
integer n,
complex*16 alpha,
complex*16, dimension(*) x,
integer incx,
complex*16, dimension(*) y,
integer incy,
complex*16, dimension(lda,*) a,
integer lda )

ZGERU

Purpose:
!>
!> ZGERU  performs the rank 1 operation
!>
!>    A := alpha*x*y**T + A,
!>
!> where alpha is a scalar, x is an m element vector, y is an n element
!> vector and A is an m by n matrix.
!>
Parameters
[in]M
!>          M is INTEGER
!>           On entry, M specifies the number of rows of the matrix A.
!>           M must be at least zero.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the number of columns of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( m - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the m
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ).
!>           Before entry, the incremented array Y must contain the n
!>           element vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
[in,out]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry, the leading m by n part of the array A must
!>           contain the matrix of coefficients. On exit, A is
!>           overwritten by the updated matrix.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, m ).
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 129 of file zgeru.f.

130*
131* -- Reference BLAS level2 routine --
132* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
133* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134*
135* .. Scalar Arguments ..
136 COMPLEX*16 ALPHA
137 INTEGER INCX,INCY,LDA,M,N
138* ..
139* .. Array Arguments ..
140 COMPLEX*16 A(LDA,*),X(*),Y(*)
141* ..
142*
143* =====================================================================
144*
145* .. Parameters ..
146 COMPLEX*16 ZERO
147 parameter(zero= (0.0d+0,0.0d+0))
148* ..
149* .. Local Scalars ..
150 COMPLEX*16 TEMP
151 INTEGER I,INFO,IX,J,JY,KX
152* ..
153* .. External Subroutines ..
154 EXTERNAL xerbla
155* ..
156* .. Intrinsic Functions ..
157 INTRINSIC max
158* ..
159*
160* Test the input parameters.
161*
162 info = 0
163 IF (m.LT.0) THEN
164 info = 1
165 ELSE IF (n.LT.0) THEN
166 info = 2
167 ELSE IF (incx.EQ.0) THEN
168 info = 5
169 ELSE IF (incy.EQ.0) THEN
170 info = 7
171 ELSE IF (lda.LT.max(1,m)) THEN
172 info = 9
173 END IF
174 IF (info.NE.0) THEN
175 CALL xerbla('ZGERU ',info)
176 RETURN
177 END IF
178*
179* Quick return if possible.
180*
181 IF ((m.EQ.0) .OR. (n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
182*
183* Start the operations. In this version the elements of A are
184* accessed sequentially with one pass through A.
185*
186 IF (incy.GT.0) THEN
187 jy = 1
188 ELSE
189 jy = 1 - (n-1)*incy
190 END IF
191 IF (incx.EQ.1) THEN
192 DO 20 j = 1,n
193 IF (y(jy).NE.zero) THEN
194 temp = alpha*y(jy)
195 DO 10 i = 1,m
196 a(i,j) = a(i,j) + x(i)*temp
197 10 CONTINUE
198 END IF
199 jy = jy + incy
200 20 CONTINUE
201 ELSE
202 IF (incx.GT.0) THEN
203 kx = 1
204 ELSE
205 kx = 1 - (m-1)*incx
206 END IF
207 DO 40 j = 1,n
208 IF (y(jy).NE.zero) THEN
209 temp = alpha*y(jy)
210 ix = kx
211 DO 30 i = 1,m
212 a(i,j) = a(i,j) + x(ix)*temp
213 ix = ix + incx
214 30 CONTINUE
215 END IF
216 jy = jy + incy
217 40 CONTINUE
218 END IF
219*
220 RETURN
221*
222* End of ZGERU
223*

◆ zhbmv()

subroutine zhbmv ( character uplo,
integer n,
integer k,
complex*16 alpha,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx,
complex*16 beta,
complex*16, dimension(*) y,
integer incy )

ZHBMV

Purpose:
!>
!> ZHBMV  performs the matrix-vector  operation
!>
!>    y := alpha*A*x + beta*y,
!>
!> where alpha and beta are scalars, x and y are n element vectors and
!> A is an n by n hermitian band matrix, with k super-diagonals.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the upper or lower
!>           triangular part of the band matrix A is being supplied as
!>           follows:
!>
!>              UPLO = 'U' or 'u'   The upper triangular part of A is
!>                                  being supplied.
!>
!>              UPLO = 'L' or 'l'   The lower triangular part of A is
!>                                  being supplied.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]K
!>          K is INTEGER
!>           On entry, K specifies the number of super-diagonals of the
!>           matrix A. K must satisfy  0 .le. K.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
!>           by n part of the array A must contain the upper triangular
!>           band part of the hermitian matrix, supplied column by
!>           column, with the leading diagonal of the matrix in row
!>           ( k + 1 ) of the array, the first super-diagonal starting at
!>           position 2 in row k, and so on. The top left k by k triangle
!>           of the array A is not referenced.
!>           The following program segment will transfer the upper
!>           triangular part of a hermitian band matrix from conventional
!>           full matrix storage to band storage:
!>
!>                 DO 20, J = 1, N
!>                    M = K + 1 - J
!>                    DO 10, I = MAX( 1, J - K ), J
!>                       A( M + I, J ) = matrix( I, J )
!>              10    CONTINUE
!>              20 CONTINUE
!>
!>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
!>           by n part of the array A must contain the lower triangular
!>           band part of the hermitian matrix, supplied column by
!>           column, with the leading diagonal of the matrix in row 1 of
!>           the array, the first sub-diagonal starting at position 1 in
!>           row 2, and so on. The bottom right k by k triangle of the
!>           array A is not referenced.
!>           The following program segment will transfer the lower
!>           triangular part of a hermitian band matrix from conventional
!>           full matrix storage to band storage:
!>
!>                 DO 20, J = 1, N
!>                    M = 1 - J
!>                    DO 10, I = J, MIN( N, J + K )
!>                       A( M + I, J ) = matrix( I, J )
!>              10    CONTINUE
!>              20 CONTINUE
!>
!>           Note that the imaginary parts of the diagonal elements need
!>           not be set and are assumed to be zero.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           ( k + 1 ).
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the
!>           vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]BETA
!>          BETA is COMPLEX*16
!>           On entry, BETA specifies the scalar beta.
!>
[in,out]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ).
!>           Before entry, the incremented array Y must contain the
!>           vector y. On exit, Y is overwritten by the updated vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 186 of file zhbmv.f.

187*
188* -- Reference BLAS level2 routine --
189* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
190* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
191*
192* .. Scalar Arguments ..
193 COMPLEX*16 ALPHA,BETA
194 INTEGER INCX,INCY,K,LDA,N
195 CHARACTER UPLO
196* ..
197* .. Array Arguments ..
198 COMPLEX*16 A(LDA,*),X(*),Y(*)
199* ..
200*
201* =====================================================================
202*
203* .. Parameters ..
204 COMPLEX*16 ONE
205 parameter(one= (1.0d+0,0.0d+0))
206 COMPLEX*16 ZERO
207 parameter(zero= (0.0d+0,0.0d+0))
208* ..
209* .. Local Scalars ..
210 COMPLEX*16 TEMP1,TEMP2
211 INTEGER I,INFO,IX,IY,J,JX,JY,KPLUS1,KX,KY,L
212* ..
213* .. External Functions ..
214 LOGICAL LSAME
215 EXTERNAL lsame
216* ..
217* .. External Subroutines ..
218 EXTERNAL xerbla
219* ..
220* .. Intrinsic Functions ..
221 INTRINSIC dble,dconjg,max,min
222* ..
223*
224* Test the input parameters.
225*
226 info = 0
227 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
228 info = 1
229 ELSE IF (n.LT.0) THEN
230 info = 2
231 ELSE IF (k.LT.0) THEN
232 info = 3
233 ELSE IF (lda.LT. (k+1)) THEN
234 info = 6
235 ELSE IF (incx.EQ.0) THEN
236 info = 8
237 ELSE IF (incy.EQ.0) THEN
238 info = 11
239 END IF
240 IF (info.NE.0) THEN
241 CALL xerbla('ZHBMV ',info)
242 RETURN
243 END IF
244*
245* Quick return if possible.
246*
247 IF ((n.EQ.0) .OR. ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
248*
249* Set up the start points in X and Y.
250*
251 IF (incx.GT.0) THEN
252 kx = 1
253 ELSE
254 kx = 1 - (n-1)*incx
255 END IF
256 IF (incy.GT.0) THEN
257 ky = 1
258 ELSE
259 ky = 1 - (n-1)*incy
260 END IF
261*
262* Start the operations. In this version the elements of the array A
263* are accessed sequentially with one pass through A.
264*
265* First form y := beta*y.
266*
267 IF (beta.NE.one) THEN
268 IF (incy.EQ.1) THEN
269 IF (beta.EQ.zero) THEN
270 DO 10 i = 1,n
271 y(i) = zero
272 10 CONTINUE
273 ELSE
274 DO 20 i = 1,n
275 y(i) = beta*y(i)
276 20 CONTINUE
277 END IF
278 ELSE
279 iy = ky
280 IF (beta.EQ.zero) THEN
281 DO 30 i = 1,n
282 y(iy) = zero
283 iy = iy + incy
284 30 CONTINUE
285 ELSE
286 DO 40 i = 1,n
287 y(iy) = beta*y(iy)
288 iy = iy + incy
289 40 CONTINUE
290 END IF
291 END IF
292 END IF
293 IF (alpha.EQ.zero) RETURN
294 IF (lsame(uplo,'U')) THEN
295*
296* Form y when upper triangle of A is stored.
297*
298 kplus1 = k + 1
299 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
300 DO 60 j = 1,n
301 temp1 = alpha*x(j)
302 temp2 = zero
303 l = kplus1 - j
304 DO 50 i = max(1,j-k),j - 1
305 y(i) = y(i) + temp1*a(l+i,j)
306 temp2 = temp2 + dconjg(a(l+i,j))*x(i)
307 50 CONTINUE
308 y(j) = y(j) + temp1*dble(a(kplus1,j)) + alpha*temp2
309 60 CONTINUE
310 ELSE
311 jx = kx
312 jy = ky
313 DO 80 j = 1,n
314 temp1 = alpha*x(jx)
315 temp2 = zero
316 ix = kx
317 iy = ky
318 l = kplus1 - j
319 DO 70 i = max(1,j-k),j - 1
320 y(iy) = y(iy) + temp1*a(l+i,j)
321 temp2 = temp2 + dconjg(a(l+i,j))*x(ix)
322 ix = ix + incx
323 iy = iy + incy
324 70 CONTINUE
325 y(jy) = y(jy) + temp1*dble(a(kplus1,j)) + alpha*temp2
326 jx = jx + incx
327 jy = jy + incy
328 IF (j.GT.k) THEN
329 kx = kx + incx
330 ky = ky + incy
331 END IF
332 80 CONTINUE
333 END IF
334 ELSE
335*
336* Form y when lower triangle of A is stored.
337*
338 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
339 DO 100 j = 1,n
340 temp1 = alpha*x(j)
341 temp2 = zero
342 y(j) = y(j) + temp1*dble(a(1,j))
343 l = 1 - j
344 DO 90 i = j + 1,min(n,j+k)
345 y(i) = y(i) + temp1*a(l+i,j)
346 temp2 = temp2 + dconjg(a(l+i,j))*x(i)
347 90 CONTINUE
348 y(j) = y(j) + alpha*temp2
349 100 CONTINUE
350 ELSE
351 jx = kx
352 jy = ky
353 DO 120 j = 1,n
354 temp1 = alpha*x(jx)
355 temp2 = zero
356 y(jy) = y(jy) + temp1*dble(a(1,j))
357 l = 1 - j
358 ix = jx
359 iy = jy
360 DO 110 i = j + 1,min(n,j+k)
361 ix = ix + incx
362 iy = iy + incy
363 y(iy) = y(iy) + temp1*a(l+i,j)
364 temp2 = temp2 + dconjg(a(l+i,j))*x(ix)
365 110 CONTINUE
366 y(jy) = y(jy) + alpha*temp2
367 jx = jx + incx
368 jy = jy + incy
369 120 CONTINUE
370 END IF
371 END IF
372*
373 RETURN
374*
375* End of ZHBMV
376*

◆ zhemv()

subroutine zhemv ( character uplo,
integer n,
complex*16 alpha,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx,
complex*16 beta,
complex*16, dimension(*) y,
integer incy )

ZHEMV

Purpose:
!>
!> ZHEMV  performs the matrix-vector  operation
!>
!>    y := alpha*A*x + beta*y,
!>
!> where alpha and beta are scalars, x and y are n element vectors and
!> A is an n by n hermitian matrix.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the upper or lower
!>           triangular part of the array A is to be referenced as
!>           follows:
!>
!>              UPLO = 'U' or 'u'   Only the upper triangular part of A
!>                                  is to be referenced.
!>
!>              UPLO = 'L' or 'l'   Only the lower triangular part of A
!>                                  is to be referenced.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry with  UPLO = 'U' or 'u', the leading n by n
!>           upper triangular part of the array A must contain the upper
!>           triangular part of the hermitian matrix and the strictly
!>           lower triangular part of A is not referenced.
!>           Before entry with UPLO = 'L' or 'l', the leading n by n
!>           lower triangular part of the array A must contain the lower
!>           triangular part of the hermitian matrix and the strictly
!>           upper triangular part of A is not referenced.
!>           Note that the imaginary parts of the diagonal elements need
!>           not be set and are assumed to be zero.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, n ).
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]BETA
!>          BETA is COMPLEX*16
!>           On entry, BETA specifies the scalar beta. When BETA is
!>           supplied as zero then Y need not be set on input.
!>
[in,out]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ).
!>           Before entry, the incremented array Y must contain the n
!>           element vector y. On exit, Y is overwritten by the updated
!>           vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 153 of file zhemv.f.

154*
155* -- Reference BLAS level2 routine --
156* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
157* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
158*
159* .. Scalar Arguments ..
160 COMPLEX*16 ALPHA,BETA
161 INTEGER INCX,INCY,LDA,N
162 CHARACTER UPLO
163* ..
164* .. Array Arguments ..
165 COMPLEX*16 A(LDA,*),X(*),Y(*)
166* ..
167*
168* =====================================================================
169*
170* .. Parameters ..
171 COMPLEX*16 ONE
172 parameter(one= (1.0d+0,0.0d+0))
173 COMPLEX*16 ZERO
174 parameter(zero= (0.0d+0,0.0d+0))
175* ..
176* .. Local Scalars ..
177 COMPLEX*16 TEMP1,TEMP2
178 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
179* ..
180* .. External Functions ..
181 LOGICAL LSAME
182 EXTERNAL lsame
183* ..
184* .. External Subroutines ..
185 EXTERNAL xerbla
186* ..
187* .. Intrinsic Functions ..
188 INTRINSIC dble,dconjg,max
189* ..
190*
191* Test the input parameters.
192*
193 info = 0
194 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
195 info = 1
196 ELSE IF (n.LT.0) THEN
197 info = 2
198 ELSE IF (lda.LT.max(1,n)) THEN
199 info = 5
200 ELSE IF (incx.EQ.0) THEN
201 info = 7
202 ELSE IF (incy.EQ.0) THEN
203 info = 10
204 END IF
205 IF (info.NE.0) THEN
206 CALL xerbla('ZHEMV ',info)
207 RETURN
208 END IF
209*
210* Quick return if possible.
211*
212 IF ((n.EQ.0) .OR. ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
213*
214* Set up the start points in X and Y.
215*
216 IF (incx.GT.0) THEN
217 kx = 1
218 ELSE
219 kx = 1 - (n-1)*incx
220 END IF
221 IF (incy.GT.0) THEN
222 ky = 1
223 ELSE
224 ky = 1 - (n-1)*incy
225 END IF
226*
227* Start the operations. In this version the elements of A are
228* accessed sequentially with one pass through the triangular part
229* of A.
230*
231* First form y := beta*y.
232*
233 IF (beta.NE.one) THEN
234 IF (incy.EQ.1) THEN
235 IF (beta.EQ.zero) THEN
236 DO 10 i = 1,n
237 y(i) = zero
238 10 CONTINUE
239 ELSE
240 DO 20 i = 1,n
241 y(i) = beta*y(i)
242 20 CONTINUE
243 END IF
244 ELSE
245 iy = ky
246 IF (beta.EQ.zero) THEN
247 DO 30 i = 1,n
248 y(iy) = zero
249 iy = iy + incy
250 30 CONTINUE
251 ELSE
252 DO 40 i = 1,n
253 y(iy) = beta*y(iy)
254 iy = iy + incy
255 40 CONTINUE
256 END IF
257 END IF
258 END IF
259 IF (alpha.EQ.zero) RETURN
260 IF (lsame(uplo,'U')) THEN
261*
262* Form y when A is stored in upper triangle.
263*
264 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
265 DO 60 j = 1,n
266 temp1 = alpha*x(j)
267 temp2 = zero
268 DO 50 i = 1,j - 1
269 y(i) = y(i) + temp1*a(i,j)
270 temp2 = temp2 + dconjg(a(i,j))*x(i)
271 50 CONTINUE
272 y(j) = y(j) + temp1*dble(a(j,j)) + alpha*temp2
273 60 CONTINUE
274 ELSE
275 jx = kx
276 jy = ky
277 DO 80 j = 1,n
278 temp1 = alpha*x(jx)
279 temp2 = zero
280 ix = kx
281 iy = ky
282 DO 70 i = 1,j - 1
283 y(iy) = y(iy) + temp1*a(i,j)
284 temp2 = temp2 + dconjg(a(i,j))*x(ix)
285 ix = ix + incx
286 iy = iy + incy
287 70 CONTINUE
288 y(jy) = y(jy) + temp1*dble(a(j,j)) + alpha*temp2
289 jx = jx + incx
290 jy = jy + incy
291 80 CONTINUE
292 END IF
293 ELSE
294*
295* Form y when A is stored in lower triangle.
296*
297 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
298 DO 100 j = 1,n
299 temp1 = alpha*x(j)
300 temp2 = zero
301 y(j) = y(j) + temp1*dble(a(j,j))
302 DO 90 i = j + 1,n
303 y(i) = y(i) + temp1*a(i,j)
304 temp2 = temp2 + dconjg(a(i,j))*x(i)
305 90 CONTINUE
306 y(j) = y(j) + alpha*temp2
307 100 CONTINUE
308 ELSE
309 jx = kx
310 jy = ky
311 DO 120 j = 1,n
312 temp1 = alpha*x(jx)
313 temp2 = zero
314 y(jy) = y(jy) + temp1*dble(a(j,j))
315 ix = jx
316 iy = jy
317 DO 110 i = j + 1,n
318 ix = ix + incx
319 iy = iy + incy
320 y(iy) = y(iy) + temp1*a(i,j)
321 temp2 = temp2 + dconjg(a(i,j))*x(ix)
322 110 CONTINUE
323 y(jy) = y(jy) + alpha*temp2
324 jx = jx + incx
325 jy = jy + incy
326 120 CONTINUE
327 END IF
328 END IF
329*
330 RETURN
331*
332* End of ZHEMV
333*

◆ zher()

subroutine zher ( character uplo,
integer n,
double precision alpha,
complex*16, dimension(*) x,
integer incx,
complex*16, dimension(lda,*) a,
integer lda )

ZHER

Purpose:
!>
!> ZHER   performs the hermitian rank 1 operation
!>
!>    A := alpha*x*x**H + A,
!>
!> where alpha is a real scalar, x is an n element vector and A is an
!> n by n hermitian matrix.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the upper or lower
!>           triangular part of the array A is to be referenced as
!>           follows:
!>
!>              UPLO = 'U' or 'u'   Only the upper triangular part of A
!>                                  is to be referenced.
!>
!>              UPLO = 'L' or 'l'   Only the lower triangular part of A
!>                                  is to be referenced.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is DOUBLE PRECISION.
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in,out]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry with  UPLO = 'U' or 'u', the leading n by n
!>           upper triangular part of the array A must contain the upper
!>           triangular part of the hermitian matrix and the strictly
!>           lower triangular part of A is not referenced. On exit, the
!>           upper triangular part of the array A is overwritten by the
!>           upper triangular part of the updated matrix.
!>           Before entry with UPLO = 'L' or 'l', the leading n by n
!>           lower triangular part of the array A must contain the lower
!>           triangular part of the hermitian matrix and the strictly
!>           upper triangular part of A is not referenced. On exit, the
!>           lower triangular part of the array A is overwritten by the
!>           lower triangular part of the updated matrix.
!>           Note that the imaginary parts of the diagonal elements need
!>           not be set, they are assumed to be zero, and on exit they
!>           are set to zero.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, n ).
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 134 of file zher.f.

135*
136* -- Reference BLAS level2 routine --
137* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
138* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
139*
140* .. Scalar Arguments ..
141 DOUBLE PRECISION ALPHA
142 INTEGER INCX,LDA,N
143 CHARACTER UPLO
144* ..
145* .. Array Arguments ..
146 COMPLEX*16 A(LDA,*),X(*)
147* ..
148*
149* =====================================================================
150*
151* .. Parameters ..
152 COMPLEX*16 ZERO
153 parameter(zero= (0.0d+0,0.0d+0))
154* ..
155* .. Local Scalars ..
156 COMPLEX*16 TEMP
157 INTEGER I,INFO,IX,J,JX,KX
158* ..
159* .. External Functions ..
160 LOGICAL LSAME
161 EXTERNAL lsame
162* ..
163* .. External Subroutines ..
164 EXTERNAL xerbla
165* ..
166* .. Intrinsic Functions ..
167 INTRINSIC dble,dconjg,max
168* ..
169*
170* Test the input parameters.
171*
172 info = 0
173 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
174 info = 1
175 ELSE IF (n.LT.0) THEN
176 info = 2
177 ELSE IF (incx.EQ.0) THEN
178 info = 5
179 ELSE IF (lda.LT.max(1,n)) THEN
180 info = 7
181 END IF
182 IF (info.NE.0) THEN
183 CALL xerbla('ZHER ',info)
184 RETURN
185 END IF
186*
187* Quick return if possible.
188*
189 IF ((n.EQ.0) .OR. (alpha.EQ.dble(zero))) RETURN
190*
191* Set the start point in X if the increment is not unity.
192*
193 IF (incx.LE.0) THEN
194 kx = 1 - (n-1)*incx
195 ELSE IF (incx.NE.1) THEN
196 kx = 1
197 END IF
198*
199* Start the operations. In this version the elements of A are
200* accessed sequentially with one pass through the triangular part
201* of A.
202*
203 IF (lsame(uplo,'U')) THEN
204*
205* Form A when A is stored in upper triangle.
206*
207 IF (incx.EQ.1) THEN
208 DO 20 j = 1,n
209 IF (x(j).NE.zero) THEN
210 temp = alpha*dconjg(x(j))
211 DO 10 i = 1,j - 1
212 a(i,j) = a(i,j) + x(i)*temp
213 10 CONTINUE
214 a(j,j) = dble(a(j,j)) + dble(x(j)*temp)
215 ELSE
216 a(j,j) = dble(a(j,j))
217 END IF
218 20 CONTINUE
219 ELSE
220 jx = kx
221 DO 40 j = 1,n
222 IF (x(jx).NE.zero) THEN
223 temp = alpha*dconjg(x(jx))
224 ix = kx
225 DO 30 i = 1,j - 1
226 a(i,j) = a(i,j) + x(ix)*temp
227 ix = ix + incx
228 30 CONTINUE
229 a(j,j) = dble(a(j,j)) + dble(x(jx)*temp)
230 ELSE
231 a(j,j) = dble(a(j,j))
232 END IF
233 jx = jx + incx
234 40 CONTINUE
235 END IF
236 ELSE
237*
238* Form A when A is stored in lower triangle.
239*
240 IF (incx.EQ.1) THEN
241 DO 60 j = 1,n
242 IF (x(j).NE.zero) THEN
243 temp = alpha*dconjg(x(j))
244 a(j,j) = dble(a(j,j)) + dble(temp*x(j))
245 DO 50 i = j + 1,n
246 a(i,j) = a(i,j) + x(i)*temp
247 50 CONTINUE
248 ELSE
249 a(j,j) = dble(a(j,j))
250 END IF
251 60 CONTINUE
252 ELSE
253 jx = kx
254 DO 80 j = 1,n
255 IF (x(jx).NE.zero) THEN
256 temp = alpha*dconjg(x(jx))
257 a(j,j) = dble(a(j,j)) + dble(temp*x(jx))
258 ix = jx
259 DO 70 i = j + 1,n
260 ix = ix + incx
261 a(i,j) = a(i,j) + x(ix)*temp
262 70 CONTINUE
263 ELSE
264 a(j,j) = dble(a(j,j))
265 END IF
266 jx = jx + incx
267 80 CONTINUE
268 END IF
269 END IF
270*
271 RETURN
272*
273* End of ZHER
274*

◆ zher2()

subroutine zher2 ( character uplo,
integer n,
complex*16 alpha,
complex*16, dimension(*) x,
integer incx,
complex*16, dimension(*) y,
integer incy,
complex*16, dimension(lda,*) a,
integer lda )

ZHER2

Purpose:
!>
!> ZHER2  performs the hermitian rank 2 operation
!>
!>    A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
!>
!> where alpha is a scalar, x and y are n element vectors and A is an n
!> by n hermitian matrix.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the upper or lower
!>           triangular part of the array A is to be referenced as
!>           follows:
!>
!>              UPLO = 'U' or 'u'   Only the upper triangular part of A
!>                                  is to be referenced.
!>
!>              UPLO = 'L' or 'l'   Only the lower triangular part of A
!>                                  is to be referenced.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ).
!>           Before entry, the incremented array Y must contain the n
!>           element vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
[in,out]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry with  UPLO = 'U' or 'u', the leading n by n
!>           upper triangular part of the array A must contain the upper
!>           triangular part of the hermitian matrix and the strictly
!>           lower triangular part of A is not referenced. On exit, the
!>           upper triangular part of the array A is overwritten by the
!>           upper triangular part of the updated matrix.
!>           Before entry with UPLO = 'L' or 'l', the leading n by n
!>           lower triangular part of the array A must contain the lower
!>           triangular part of the hermitian matrix and the strictly
!>           upper triangular part of A is not referenced. On exit, the
!>           lower triangular part of the array A is overwritten by the
!>           lower triangular part of the updated matrix.
!>           Note that the imaginary parts of the diagonal elements need
!>           not be set, they are assumed to be zero, and on exit they
!>           are set to zero.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, n ).
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 149 of file zher2.f.

150*
151* -- Reference BLAS level2 routine --
152* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
153* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
154*
155* .. Scalar Arguments ..
156 COMPLEX*16 ALPHA
157 INTEGER INCX,INCY,LDA,N
158 CHARACTER UPLO
159* ..
160* .. Array Arguments ..
161 COMPLEX*16 A(LDA,*),X(*),Y(*)
162* ..
163*
164* =====================================================================
165*
166* .. Parameters ..
167 COMPLEX*16 ZERO
168 parameter(zero= (0.0d+0,0.0d+0))
169* ..
170* .. Local Scalars ..
171 COMPLEX*16 TEMP1,TEMP2
172 INTEGER I,INFO,IX,IY,J,JX,JY,KX,KY
173* ..
174* .. External Functions ..
175 LOGICAL LSAME
176 EXTERNAL lsame
177* ..
178* .. External Subroutines ..
179 EXTERNAL xerbla
180* ..
181* .. Intrinsic Functions ..
182 INTRINSIC dble,dconjg,max
183* ..
184*
185* Test the input parameters.
186*
187 info = 0
188 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
189 info = 1
190 ELSE IF (n.LT.0) THEN
191 info = 2
192 ELSE IF (incx.EQ.0) THEN
193 info = 5
194 ELSE IF (incy.EQ.0) THEN
195 info = 7
196 ELSE IF (lda.LT.max(1,n)) THEN
197 info = 9
198 END IF
199 IF (info.NE.0) THEN
200 CALL xerbla('ZHER2 ',info)
201 RETURN
202 END IF
203*
204* Quick return if possible.
205*
206 IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
207*
208* Set up the start points in X and Y if the increments are not both
209* unity.
210*
211 IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
212 IF (incx.GT.0) THEN
213 kx = 1
214 ELSE
215 kx = 1 - (n-1)*incx
216 END IF
217 IF (incy.GT.0) THEN
218 ky = 1
219 ELSE
220 ky = 1 - (n-1)*incy
221 END IF
222 jx = kx
223 jy = ky
224 END IF
225*
226* Start the operations. In this version the elements of A are
227* accessed sequentially with one pass through the triangular part
228* of A.
229*
230 IF (lsame(uplo,'U')) THEN
231*
232* Form A when A is stored in the upper triangle.
233*
234 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
235 DO 20 j = 1,n
236 IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
237 temp1 = alpha*dconjg(y(j))
238 temp2 = dconjg(alpha*x(j))
239 DO 10 i = 1,j - 1
240 a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
241 10 CONTINUE
242 a(j,j) = dble(a(j,j)) +
243 + dble(x(j)*temp1+y(j)*temp2)
244 ELSE
245 a(j,j) = dble(a(j,j))
246 END IF
247 20 CONTINUE
248 ELSE
249 DO 40 j = 1,n
250 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
251 temp1 = alpha*dconjg(y(jy))
252 temp2 = dconjg(alpha*x(jx))
253 ix = kx
254 iy = ky
255 DO 30 i = 1,j - 1
256 a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
257 ix = ix + incx
258 iy = iy + incy
259 30 CONTINUE
260 a(j,j) = dble(a(j,j)) +
261 + dble(x(jx)*temp1+y(jy)*temp2)
262 ELSE
263 a(j,j) = dble(a(j,j))
264 END IF
265 jx = jx + incx
266 jy = jy + incy
267 40 CONTINUE
268 END IF
269 ELSE
270*
271* Form A when A is stored in the lower triangle.
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 a(j,j) = dble(a(j,j)) +
279 + dble(x(j)*temp1+y(j)*temp2)
280 DO 50 i = j + 1,n
281 a(i,j) = a(i,j) + x(i)*temp1 + y(i)*temp2
282 50 CONTINUE
283 ELSE
284 a(j,j) = dble(a(j,j))
285 END IF
286 60 CONTINUE
287 ELSE
288 DO 80 j = 1,n
289 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
290 temp1 = alpha*dconjg(y(jy))
291 temp2 = dconjg(alpha*x(jx))
292 a(j,j) = dble(a(j,j)) +
293 + dble(x(jx)*temp1+y(jy)*temp2)
294 ix = jx
295 iy = jy
296 DO 70 i = j + 1,n
297 ix = ix + incx
298 iy = iy + incy
299 a(i,j) = a(i,j) + x(ix)*temp1 + y(iy)*temp2
300 70 CONTINUE
301 ELSE
302 a(j,j) = dble(a(j,j))
303 END IF
304 jx = jx + incx
305 jy = jy + incy
306 80 CONTINUE
307 END IF
308 END IF
309*
310 RETURN
311*
312* End of ZHER2
313*

◆ zhpmv()

subroutine zhpmv ( character uplo,
integer n,
complex*16 alpha,
complex*16, dimension(*) ap,
complex*16, dimension(*) x,
integer incx,
complex*16 beta,
complex*16, dimension(*) y,
integer incy )

ZHPMV

Purpose:
!>
!> ZHPMV  performs the matrix-vector operation
!>
!>    y := alpha*A*x + beta*y,
!>
!> where alpha and beta are scalars, x and y are n element vectors and
!> A is an n by n hermitian matrix, supplied in packed form.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the upper or lower
!>           triangular part of the matrix A is supplied in the packed
!>           array AP as follows:
!>
!>              UPLO = 'U' or 'u'   The upper triangular part of A is
!>                                  supplied in AP.
!>
!>              UPLO = 'L' or 'l'   The lower triangular part of A is
!>                                  supplied in AP.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]AP
!>          AP is COMPLEX*16 array, dimension at least
!>           ( ( n*( n + 1 ) )/2 ).
!>           Before entry with UPLO = 'U' or 'u', the array AP must
!>           contain the upper triangular part of the hermitian matrix
!>           packed sequentially, column by column, so that AP( 1 )
!>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
!>           and a( 2, 2 ) respectively, and so on.
!>           Before entry with UPLO = 'L' or 'l', the array AP must
!>           contain the lower triangular part of the hermitian matrix
!>           packed sequentially, column by column, so that AP( 1 )
!>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
!>           and a( 3, 1 ) respectively, and so on.
!>           Note that the imaginary parts of the diagonal elements need
!>           not be set and are assumed to be zero.
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]BETA
!>          BETA is COMPLEX*16
!>           On entry, BETA specifies the scalar beta. When BETA is
!>           supplied as zero then Y need not be set on input.
!>
[in,out]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ).
!>           Before entry, the incremented array Y must contain the n
!>           element vector y. On exit, Y is overwritten by the updated
!>           vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 148 of file zhpmv.f.

149*
150* -- Reference BLAS level2 routine --
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*
154* .. Scalar Arguments ..
155 COMPLEX*16 ALPHA,BETA
156 INTEGER INCX,INCY,N
157 CHARACTER UPLO
158* ..
159* .. Array Arguments ..
160 COMPLEX*16 AP(*),X(*),Y(*)
161* ..
162*
163* =====================================================================
164*
165* .. Parameters ..
166 COMPLEX*16 ONE
167 parameter(one= (1.0d+0,0.0d+0))
168 COMPLEX*16 ZERO
169 parameter(zero= (0.0d+0,0.0d+0))
170* ..
171* .. Local Scalars ..
172 COMPLEX*16 TEMP1,TEMP2
173 INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
174* ..
175* .. External Functions ..
176 LOGICAL LSAME
177 EXTERNAL lsame
178* ..
179* .. External Subroutines ..
180 EXTERNAL xerbla
181* ..
182* .. Intrinsic Functions ..
183 INTRINSIC dble,dconjg
184* ..
185*
186* Test the input parameters.
187*
188 info = 0
189 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
190 info = 1
191 ELSE IF (n.LT.0) THEN
192 info = 2
193 ELSE IF (incx.EQ.0) THEN
194 info = 6
195 ELSE IF (incy.EQ.0) THEN
196 info = 9
197 END IF
198 IF (info.NE.0) THEN
199 CALL xerbla('ZHPMV ',info)
200 RETURN
201 END IF
202*
203* Quick return if possible.
204*
205 IF ((n.EQ.0) .OR. ((alpha.EQ.zero).AND. (beta.EQ.one))) RETURN
206*
207* Set up the start points in X and Y.
208*
209 IF (incx.GT.0) THEN
210 kx = 1
211 ELSE
212 kx = 1 - (n-1)*incx
213 END IF
214 IF (incy.GT.0) THEN
215 ky = 1
216 ELSE
217 ky = 1 - (n-1)*incy
218 END IF
219*
220* Start the operations. In this version the elements of the array AP
221* are accessed sequentially with one pass through AP.
222*
223* First form y := beta*y.
224*
225 IF (beta.NE.one) THEN
226 IF (incy.EQ.1) THEN
227 IF (beta.EQ.zero) THEN
228 DO 10 i = 1,n
229 y(i) = zero
230 10 CONTINUE
231 ELSE
232 DO 20 i = 1,n
233 y(i) = beta*y(i)
234 20 CONTINUE
235 END IF
236 ELSE
237 iy = ky
238 IF (beta.EQ.zero) THEN
239 DO 30 i = 1,n
240 y(iy) = zero
241 iy = iy + incy
242 30 CONTINUE
243 ELSE
244 DO 40 i = 1,n
245 y(iy) = beta*y(iy)
246 iy = iy + incy
247 40 CONTINUE
248 END IF
249 END IF
250 END IF
251 IF (alpha.EQ.zero) RETURN
252 kk = 1
253 IF (lsame(uplo,'U')) THEN
254*
255* Form y when AP contains the upper triangle.
256*
257 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
258 DO 60 j = 1,n
259 temp1 = alpha*x(j)
260 temp2 = zero
261 k = kk
262 DO 50 i = 1,j - 1
263 y(i) = y(i) + temp1*ap(k)
264 temp2 = temp2 + dconjg(ap(k))*x(i)
265 k = k + 1
266 50 CONTINUE
267 y(j) = y(j) + temp1*dble(ap(kk+j-1)) + alpha*temp2
268 kk = kk + j
269 60 CONTINUE
270 ELSE
271 jx = kx
272 jy = ky
273 DO 80 j = 1,n
274 temp1 = alpha*x(jx)
275 temp2 = zero
276 ix = kx
277 iy = ky
278 DO 70 k = kk,kk + j - 2
279 y(iy) = y(iy) + temp1*ap(k)
280 temp2 = temp2 + dconjg(ap(k))*x(ix)
281 ix = ix + incx
282 iy = iy + incy
283 70 CONTINUE
284 y(jy) = y(jy) + temp1*dble(ap(kk+j-1)) + alpha*temp2
285 jx = jx + incx
286 jy = jy + incy
287 kk = kk + j
288 80 CONTINUE
289 END IF
290 ELSE
291*
292* Form y when AP contains the lower triangle.
293*
294 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
295 DO 100 j = 1,n
296 temp1 = alpha*x(j)
297 temp2 = zero
298 y(j) = y(j) + temp1*dble(ap(kk))
299 k = kk + 1
300 DO 90 i = j + 1,n
301 y(i) = y(i) + temp1*ap(k)
302 temp2 = temp2 + dconjg(ap(k))*x(i)
303 k = k + 1
304 90 CONTINUE
305 y(j) = y(j) + alpha*temp2
306 kk = kk + (n-j+1)
307 100 CONTINUE
308 ELSE
309 jx = kx
310 jy = ky
311 DO 120 j = 1,n
312 temp1 = alpha*x(jx)
313 temp2 = zero
314 y(jy) = y(jy) + temp1*dble(ap(kk))
315 ix = jx
316 iy = jy
317 DO 110 k = kk + 1,kk + n - j
318 ix = ix + incx
319 iy = iy + incy
320 y(iy) = y(iy) + temp1*ap(k)
321 temp2 = temp2 + dconjg(ap(k))*x(ix)
322 110 CONTINUE
323 y(jy) = y(jy) + alpha*temp2
324 jx = jx + incx
325 jy = jy + incy
326 kk = kk + (n-j+1)
327 120 CONTINUE
328 END IF
329 END IF
330*
331 RETURN
332*
333* End of ZHPMV
334*

◆ zhpr()

subroutine zhpr ( character uplo,
integer n,
double precision alpha,
complex*16, dimension(*) x,
integer incx,
complex*16, dimension(*) ap )

ZHPR

Purpose:
!>
!> ZHPR    performs the hermitian rank 1 operation
!>
!>    A := alpha*x*x**H + A,
!>
!> where alpha is a real scalar, x is an n element vector and A is an
!> n by n hermitian matrix, supplied in packed form.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the upper or lower
!>           triangular part of the matrix A is supplied in the packed
!>           array AP as follows:
!>
!>              UPLO = 'U' or 'u'   The upper triangular part of A is
!>                                  supplied in AP.
!>
!>              UPLO = 'L' or 'l'   The lower triangular part of A is
!>                                  supplied in AP.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is DOUBLE PRECISION.
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in,out]AP
!>          AP is COMPLEX*16 array, dimension at least
!>           ( ( n*( n + 1 ) )/2 ).
!>           Before entry with  UPLO = 'U' or 'u', the array AP must
!>           contain the upper triangular part of the hermitian matrix
!>           packed sequentially, column by column, so that AP( 1 )
!>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
!>           and a( 2, 2 ) respectively, and so on. On exit, the array
!>           AP is overwritten by the upper triangular part of the
!>           updated matrix.
!>           Before entry with UPLO = 'L' or 'l', the array AP must
!>           contain the lower triangular part of the hermitian matrix
!>           packed sequentially, column by column, so that AP( 1 )
!>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
!>           and a( 3, 1 ) respectively, and so on. On exit, the array
!>           AP is overwritten by the lower triangular part of the
!>           updated matrix.
!>           Note that the imaginary parts of the diagonal elements need
!>           not be set, they are assumed to be zero, and on exit they
!>           are set to zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 129 of file zhpr.f.

130*
131* -- Reference BLAS level2 routine --
132* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
133* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134*
135* .. Scalar Arguments ..
136 DOUBLE PRECISION ALPHA
137 INTEGER INCX,N
138 CHARACTER UPLO
139* ..
140* .. Array Arguments ..
141 COMPLEX*16 AP(*),X(*)
142* ..
143*
144* =====================================================================
145*
146* .. Parameters ..
147 COMPLEX*16 ZERO
148 parameter(zero= (0.0d+0,0.0d+0))
149* ..
150* .. Local Scalars ..
151 COMPLEX*16 TEMP
152 INTEGER I,INFO,IX,J,JX,K,KK,KX
153* ..
154* .. External Functions ..
155 LOGICAL LSAME
156 EXTERNAL lsame
157* ..
158* .. External Subroutines ..
159 EXTERNAL xerbla
160* ..
161* .. Intrinsic Functions ..
162 INTRINSIC dble,dconjg
163* ..
164*
165* Test the input parameters.
166*
167 info = 0
168 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
169 info = 1
170 ELSE IF (n.LT.0) THEN
171 info = 2
172 ELSE IF (incx.EQ.0) THEN
173 info = 5
174 END IF
175 IF (info.NE.0) THEN
176 CALL xerbla('ZHPR ',info)
177 RETURN
178 END IF
179*
180* Quick return if possible.
181*
182 IF ((n.EQ.0) .OR. (alpha.EQ.dble(zero))) RETURN
183*
184* Set the start point in X if the increment is not unity.
185*
186 IF (incx.LE.0) THEN
187 kx = 1 - (n-1)*incx
188 ELSE IF (incx.NE.1) THEN
189 kx = 1
190 END IF
191*
192* Start the operations. In this version the elements of the array AP
193* are accessed sequentially with one pass through AP.
194*
195 kk = 1
196 IF (lsame(uplo,'U')) THEN
197*
198* Form A when upper triangle is stored in AP.
199*
200 IF (incx.EQ.1) THEN
201 DO 20 j = 1,n
202 IF (x(j).NE.zero) THEN
203 temp = alpha*dconjg(x(j))
204 k = kk
205 DO 10 i = 1,j - 1
206 ap(k) = ap(k) + x(i)*temp
207 k = k + 1
208 10 CONTINUE
209 ap(kk+j-1) = dble(ap(kk+j-1)) + dble(x(j)*temp)
210 ELSE
211 ap(kk+j-1) = dble(ap(kk+j-1))
212 END IF
213 kk = kk + j
214 20 CONTINUE
215 ELSE
216 jx = kx
217 DO 40 j = 1,n
218 IF (x(jx).NE.zero) THEN
219 temp = alpha*dconjg(x(jx))
220 ix = kx
221 DO 30 k = kk,kk + j - 2
222 ap(k) = ap(k) + x(ix)*temp
223 ix = ix + incx
224 30 CONTINUE
225 ap(kk+j-1) = dble(ap(kk+j-1)) + dble(x(jx)*temp)
226 ELSE
227 ap(kk+j-1) = dble(ap(kk+j-1))
228 END IF
229 jx = jx + incx
230 kk = kk + j
231 40 CONTINUE
232 END IF
233 ELSE
234*
235* Form A when lower triangle is stored in AP.
236*
237 IF (incx.EQ.1) THEN
238 DO 60 j = 1,n
239 IF (x(j).NE.zero) THEN
240 temp = alpha*dconjg(x(j))
241 ap(kk) = dble(ap(kk)) + dble(temp*x(j))
242 k = kk + 1
243 DO 50 i = j + 1,n
244 ap(k) = ap(k) + x(i)*temp
245 k = k + 1
246 50 CONTINUE
247 ELSE
248 ap(kk) = dble(ap(kk))
249 END IF
250 kk = kk + n - j + 1
251 60 CONTINUE
252 ELSE
253 jx = kx
254 DO 80 j = 1,n
255 IF (x(jx).NE.zero) THEN
256 temp = alpha*dconjg(x(jx))
257 ap(kk) = dble(ap(kk)) + dble(temp*x(jx))
258 ix = jx
259 DO 70 k = kk + 1,kk + n - j
260 ix = ix + incx
261 ap(k) = ap(k) + x(ix)*temp
262 70 CONTINUE
263 ELSE
264 ap(kk) = dble(ap(kk))
265 END IF
266 jx = jx + incx
267 kk = kk + n - j + 1
268 80 CONTINUE
269 END IF
270 END IF
271*
272 RETURN
273*
274* End of ZHPR
275*

◆ zhpr2()

subroutine zhpr2 ( character uplo,
integer n,
complex*16 alpha,
complex*16, dimension(*) x,
integer incx,
complex*16, dimension(*) y,
integer incy,
complex*16, dimension(*) ap )

ZHPR2

Purpose:
!>
!> ZHPR2  performs the hermitian rank 2 operation
!>
!>    A := alpha*x*y**H + conjg( alpha )*y*x**H + A,
!>
!> where alpha is a scalar, x and y are n element vectors and A is an
!> n by n hermitian matrix, supplied in packed form.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the upper or lower
!>           triangular part of the matrix A is supplied in the packed
!>           array AP as follows:
!>
!>              UPLO = 'U' or 'u'   The upper triangular part of A is
!>                                  supplied in AP.
!>
!>              UPLO = 'L' or 'l'   The lower triangular part of A is
!>                                  supplied in AP.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]ALPHA
!>          ALPHA is COMPLEX*16
!>           On entry, ALPHA specifies the scalar alpha.
!>
[in]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
[in]Y
!>          Y is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCY ) ).
!>           Before entry, the incremented array Y must contain the n
!>           element vector y.
!>
[in]INCY
!>          INCY is INTEGER
!>           On entry, INCY specifies the increment for the elements of
!>           Y. INCY must not be zero.
!>
[in,out]AP
!>          AP is COMPLEX*16 array, dimension at least
!>           ( ( n*( n + 1 ) )/2 ).
!>           Before entry with  UPLO = 'U' or 'u', the array AP must
!>           contain the upper triangular part of the hermitian matrix
!>           packed sequentially, column by column, so that AP( 1 )
!>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 1, 2 )
!>           and a( 2, 2 ) respectively, and so on. On exit, the array
!>           AP is overwritten by the upper triangular part of the
!>           updated matrix.
!>           Before entry with UPLO = 'L' or 'l', the array AP must
!>           contain the lower triangular part of the hermitian matrix
!>           packed sequentially, column by column, so that AP( 1 )
!>           contains a( 1, 1 ), AP( 2 ) and AP( 3 ) contain a( 2, 1 )
!>           and a( 3, 1 ) respectively, and so on. On exit, the array
!>           AP is overwritten by the lower triangular part of the
!>           updated matrix.
!>           Note that the imaginary parts of the diagonal elements need
!>           not be set, they are assumed to be zero, and on exit they
!>           are set to zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 144 of file zhpr2.f.

145*
146* -- Reference BLAS level2 routine --
147* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
148* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
149*
150* .. Scalar Arguments ..
151 COMPLEX*16 ALPHA
152 INTEGER INCX,INCY,N
153 CHARACTER UPLO
154* ..
155* .. Array Arguments ..
156 COMPLEX*16 AP(*),X(*),Y(*)
157* ..
158*
159* =====================================================================
160*
161* .. Parameters ..
162 COMPLEX*16 ZERO
163 parameter(zero= (0.0d+0,0.0d+0))
164* ..
165* .. Local Scalars ..
166 COMPLEX*16 TEMP1,TEMP2
167 INTEGER I,INFO,IX,IY,J,JX,JY,K,KK,KX,KY
168* ..
169* .. External Functions ..
170 LOGICAL LSAME
171 EXTERNAL lsame
172* ..
173* .. External Subroutines ..
174 EXTERNAL xerbla
175* ..
176* .. Intrinsic Functions ..
177 INTRINSIC dble,dconjg
178* ..
179*
180* Test the input parameters.
181*
182 info = 0
183 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
184 info = 1
185 ELSE IF (n.LT.0) THEN
186 info = 2
187 ELSE IF (incx.EQ.0) THEN
188 info = 5
189 ELSE IF (incy.EQ.0) THEN
190 info = 7
191 END IF
192 IF (info.NE.0) THEN
193 CALL xerbla('ZHPR2 ',info)
194 RETURN
195 END IF
196*
197* Quick return if possible.
198*
199 IF ((n.EQ.0) .OR. (alpha.EQ.zero)) RETURN
200*
201* Set up the start points in X and Y if the increments are not both
202* unity.
203*
204 IF ((incx.NE.1) .OR. (incy.NE.1)) THEN
205 IF (incx.GT.0) THEN
206 kx = 1
207 ELSE
208 kx = 1 - (n-1)*incx
209 END IF
210 IF (incy.GT.0) THEN
211 ky = 1
212 ELSE
213 ky = 1 - (n-1)*incy
214 END IF
215 jx = kx
216 jy = ky
217 END IF
218*
219* Start the operations. In this version the elements of the array AP
220* are accessed sequentially with one pass through AP.
221*
222 kk = 1
223 IF (lsame(uplo,'U')) THEN
224*
225* Form A when upper triangle is stored in AP.
226*
227 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
228 DO 20 j = 1,n
229 IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
230 temp1 = alpha*dconjg(y(j))
231 temp2 = dconjg(alpha*x(j))
232 k = kk
233 DO 10 i = 1,j - 1
234 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
235 k = k + 1
236 10 CONTINUE
237 ap(kk+j-1) = dble(ap(kk+j-1)) +
238 + dble(x(j)*temp1+y(j)*temp2)
239 ELSE
240 ap(kk+j-1) = dble(ap(kk+j-1))
241 END IF
242 kk = kk + j
243 20 CONTINUE
244 ELSE
245 DO 40 j = 1,n
246 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
247 temp1 = alpha*dconjg(y(jy))
248 temp2 = dconjg(alpha*x(jx))
249 ix = kx
250 iy = ky
251 DO 30 k = kk,kk + j - 2
252 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
253 ix = ix + incx
254 iy = iy + incy
255 30 CONTINUE
256 ap(kk+j-1) = dble(ap(kk+j-1)) +
257 + dble(x(jx)*temp1+y(jy)*temp2)
258 ELSE
259 ap(kk+j-1) = dble(ap(kk+j-1))
260 END IF
261 jx = jx + incx
262 jy = jy + incy
263 kk = kk + j
264 40 CONTINUE
265 END IF
266 ELSE
267*
268* Form A when lower triangle is stored in AP.
269*
270 IF ((incx.EQ.1) .AND. (incy.EQ.1)) THEN
271 DO 60 j = 1,n
272 IF ((x(j).NE.zero) .OR. (y(j).NE.zero)) THEN
273 temp1 = alpha*dconjg(y(j))
274 temp2 = dconjg(alpha*x(j))
275 ap(kk) = dble(ap(kk)) +
276 + dble(x(j)*temp1+y(j)*temp2)
277 k = kk + 1
278 DO 50 i = j + 1,n
279 ap(k) = ap(k) + x(i)*temp1 + y(i)*temp2
280 k = k + 1
281 50 CONTINUE
282 ELSE
283 ap(kk) = dble(ap(kk))
284 END IF
285 kk = kk + n - j + 1
286 60 CONTINUE
287 ELSE
288 DO 80 j = 1,n
289 IF ((x(jx).NE.zero) .OR. (y(jy).NE.zero)) THEN
290 temp1 = alpha*dconjg(y(jy))
291 temp2 = dconjg(alpha*x(jx))
292 ap(kk) = dble(ap(kk)) +
293 + dble(x(jx)*temp1+y(jy)*temp2)
294 ix = jx
295 iy = jy
296 DO 70 k = kk + 1,kk + n - j
297 ix = ix + incx
298 iy = iy + incy
299 ap(k) = ap(k) + x(ix)*temp1 + y(iy)*temp2
300 70 CONTINUE
301 ELSE
302 ap(kk) = dble(ap(kk))
303 END IF
304 jx = jx + incx
305 jy = jy + incy
306 kk = kk + n - j + 1
307 80 CONTINUE
308 END IF
309 END IF
310*
311 RETURN
312*
313* End of ZHPR2
314*

◆ ztbmv()

subroutine ztbmv ( character uplo,
character trans,
character diag,
integer n,
integer k,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx )

ZTBMV

Purpose:
!>
!> ZTBMV  performs one of the matrix-vector operations
!>
!>    x := A*x,   or   x := A**T*x,   or   x := A**H*x,
!>
!> where x is an n element vector and  A is an n by n unit, or non-unit,
!> upper or lower triangular band matrix, with ( k + 1 ) diagonals.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the matrix is an upper or
!>           lower triangular matrix as follows:
!>
!>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
!>
!>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the operation to be performed as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   x := A*x.
!>
!>              TRANS = 'T' or 't'   x := A**T*x.
!>
!>              TRANS = 'C' or 'c'   x := A**H*x.
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>           On entry, DIAG specifies whether or not A is unit
!>           triangular as follows:
!>
!>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
!>
!>              DIAG = 'N' or 'n'   A is not assumed to be unit
!>                                  triangular.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]K
!>          K is INTEGER
!>           On entry with UPLO = 'U' or 'u', K specifies the number of
!>           super-diagonals of the matrix A.
!>           On entry with UPLO = 'L' or 'l', K specifies the number of
!>           sub-diagonals of the matrix A.
!>           K must satisfy  0 .le. K.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N ).
!>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
!>           by n part of the array A must contain the upper triangular
!>           band part of the matrix of coefficients, supplied column by
!>           column, with the leading diagonal of the matrix in row
!>           ( k + 1 ) of the array, the first super-diagonal starting at
!>           position 2 in row k, and so on. The top left k by k triangle
!>           of the array A is not referenced.
!>           The following program segment will transfer an upper
!>           triangular band matrix from conventional full matrix storage
!>           to band storage:
!>
!>                 DO 20, J = 1, N
!>                    M = K + 1 - J
!>                    DO 10, I = MAX( 1, J - K ), J
!>                       A( M + I, J ) = matrix( I, J )
!>              10    CONTINUE
!>              20 CONTINUE
!>
!>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
!>           by n part of the array A must contain the lower triangular
!>           band part of the matrix of coefficients, supplied column by
!>           column, with the leading diagonal of the matrix in row 1 of
!>           the array, the first sub-diagonal starting at position 1 in
!>           row 2, and so on. The bottom right k by k triangle of the
!>           array A is not referenced.
!>           The following program segment will transfer a lower
!>           triangular band matrix from conventional full matrix storage
!>           to band storage:
!>
!>                 DO 20, J = 1, N
!>                    M = 1 - J
!>                    DO 10, I = J, MIN( N, J + K )
!>                       A( M + I, J ) = matrix( I, J )
!>              10    CONTINUE
!>              20 CONTINUE
!>
!>           Note that when DIAG = 'U' or 'u' the elements of the array A
!>           corresponding to the diagonal elements of the matrix are not
!>           referenced, but are assumed to be unity.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           ( k + 1 ).
!>
[in,out]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x. On exit, X is overwritten with the
!>           transformed vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 185 of file ztbmv.f.

186*
187* -- Reference BLAS level2 routine --
188* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
189* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
190*
191* .. Scalar Arguments ..
192 INTEGER INCX,K,LDA,N
193 CHARACTER DIAG,TRANS,UPLO
194* ..
195* .. Array Arguments ..
196 COMPLEX*16 A(LDA,*),X(*)
197* ..
198*
199* =====================================================================
200*
201* .. Parameters ..
202 COMPLEX*16 ZERO
203 parameter(zero= (0.0d+0,0.0d+0))
204* ..
205* .. Local Scalars ..
206 COMPLEX*16 TEMP
207 INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
208 LOGICAL NOCONJ,NOUNIT
209* ..
210* .. External Functions ..
211 LOGICAL LSAME
212 EXTERNAL lsame
213* ..
214* .. External Subroutines ..
215 EXTERNAL xerbla
216* ..
217* .. Intrinsic Functions ..
218 INTRINSIC dconjg,max,min
219* ..
220*
221* Test the input parameters.
222*
223 info = 0
224 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
225 info = 1
226 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
227 + .NOT.lsame(trans,'C')) THEN
228 info = 2
229 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
230 info = 3
231 ELSE IF (n.LT.0) THEN
232 info = 4
233 ELSE IF (k.LT.0) THEN
234 info = 5
235 ELSE IF (lda.LT. (k+1)) THEN
236 info = 7
237 ELSE IF (incx.EQ.0) THEN
238 info = 9
239 END IF
240 IF (info.NE.0) THEN
241 CALL xerbla('ZTBMV ',info)
242 RETURN
243 END IF
244*
245* Quick return if possible.
246*
247 IF (n.EQ.0) RETURN
248*
249 noconj = lsame(trans,'T')
250 nounit = lsame(diag,'N')
251*
252* Set up the start point in X if the increment is not unity. This
253* will be ( N - 1 )*INCX too small for descending loops.
254*
255 IF (incx.LE.0) THEN
256 kx = 1 - (n-1)*incx
257 ELSE IF (incx.NE.1) THEN
258 kx = 1
259 END IF
260*
261* Start the operations. In this version the elements of A are
262* accessed sequentially with one pass through A.
263*
264 IF (lsame(trans,'N')) THEN
265*
266* Form x := A*x.
267*
268 IF (lsame(uplo,'U')) THEN
269 kplus1 = k + 1
270 IF (incx.EQ.1) THEN
271 DO 20 j = 1,n
272 IF (x(j).NE.zero) THEN
273 temp = x(j)
274 l = kplus1 - j
275 DO 10 i = max(1,j-k),j - 1
276 x(i) = x(i) + temp*a(l+i,j)
277 10 CONTINUE
278 IF (nounit) x(j) = x(j)*a(kplus1,j)
279 END IF
280 20 CONTINUE
281 ELSE
282 jx = kx
283 DO 40 j = 1,n
284 IF (x(jx).NE.zero) THEN
285 temp = x(jx)
286 ix = kx
287 l = kplus1 - j
288 DO 30 i = max(1,j-k),j - 1
289 x(ix) = x(ix) + temp*a(l+i,j)
290 ix = ix + incx
291 30 CONTINUE
292 IF (nounit) x(jx) = x(jx)*a(kplus1,j)
293 END IF
294 jx = jx + incx
295 IF (j.GT.k) kx = kx + incx
296 40 CONTINUE
297 END IF
298 ELSE
299 IF (incx.EQ.1) THEN
300 DO 60 j = n,1,-1
301 IF (x(j).NE.zero) THEN
302 temp = x(j)
303 l = 1 - j
304 DO 50 i = min(n,j+k),j + 1,-1
305 x(i) = x(i) + temp*a(l+i,j)
306 50 CONTINUE
307 IF (nounit) x(j) = x(j)*a(1,j)
308 END IF
309 60 CONTINUE
310 ELSE
311 kx = kx + (n-1)*incx
312 jx = kx
313 DO 80 j = n,1,-1
314 IF (x(jx).NE.zero) THEN
315 temp = x(jx)
316 ix = kx
317 l = 1 - j
318 DO 70 i = min(n,j+k),j + 1,-1
319 x(ix) = x(ix) + temp*a(l+i,j)
320 ix = ix - incx
321 70 CONTINUE
322 IF (nounit) x(jx) = x(jx)*a(1,j)
323 END IF
324 jx = jx - incx
325 IF ((n-j).GE.k) kx = kx - incx
326 80 CONTINUE
327 END IF
328 END IF
329 ELSE
330*
331* Form x := A**T*x or x := A**H*x.
332*
333 IF (lsame(uplo,'U')) THEN
334 kplus1 = k + 1
335 IF (incx.EQ.1) THEN
336 DO 110 j = n,1,-1
337 temp = x(j)
338 l = kplus1 - j
339 IF (noconj) THEN
340 IF (nounit) temp = temp*a(kplus1,j)
341 DO 90 i = j - 1,max(1,j-k),-1
342 temp = temp + a(l+i,j)*x(i)
343 90 CONTINUE
344 ELSE
345 IF (nounit) temp = temp*dconjg(a(kplus1,j))
346 DO 100 i = j - 1,max(1,j-k),-1
347 temp = temp + dconjg(a(l+i,j))*x(i)
348 100 CONTINUE
349 END IF
350 x(j) = temp
351 110 CONTINUE
352 ELSE
353 kx = kx + (n-1)*incx
354 jx = kx
355 DO 140 j = n,1,-1
356 temp = x(jx)
357 kx = kx - incx
358 ix = kx
359 l = kplus1 - j
360 IF (noconj) THEN
361 IF (nounit) temp = temp*a(kplus1,j)
362 DO 120 i = j - 1,max(1,j-k),-1
363 temp = temp + a(l+i,j)*x(ix)
364 ix = ix - incx
365 120 CONTINUE
366 ELSE
367 IF (nounit) temp = temp*dconjg(a(kplus1,j))
368 DO 130 i = j - 1,max(1,j-k),-1
369 temp = temp + dconjg(a(l+i,j))*x(ix)
370 ix = ix - incx
371 130 CONTINUE
372 END IF
373 x(jx) = temp
374 jx = jx - incx
375 140 CONTINUE
376 END IF
377 ELSE
378 IF (incx.EQ.1) THEN
379 DO 170 j = 1,n
380 temp = x(j)
381 l = 1 - j
382 IF (noconj) THEN
383 IF (nounit) temp = temp*a(1,j)
384 DO 150 i = j + 1,min(n,j+k)
385 temp = temp + a(l+i,j)*x(i)
386 150 CONTINUE
387 ELSE
388 IF (nounit) temp = temp*dconjg(a(1,j))
389 DO 160 i = j + 1,min(n,j+k)
390 temp = temp + dconjg(a(l+i,j))*x(i)
391 160 CONTINUE
392 END IF
393 x(j) = temp
394 170 CONTINUE
395 ELSE
396 jx = kx
397 DO 200 j = 1,n
398 temp = x(jx)
399 kx = kx + incx
400 ix = kx
401 l = 1 - j
402 IF (noconj) THEN
403 IF (nounit) temp = temp*a(1,j)
404 DO 180 i = j + 1,min(n,j+k)
405 temp = temp + a(l+i,j)*x(ix)
406 ix = ix + incx
407 180 CONTINUE
408 ELSE
409 IF (nounit) temp = temp*dconjg(a(1,j))
410 DO 190 i = j + 1,min(n,j+k)
411 temp = temp + dconjg(a(l+i,j))*x(ix)
412 ix = ix + incx
413 190 CONTINUE
414 END IF
415 x(jx) = temp
416 jx = jx + incx
417 200 CONTINUE
418 END IF
419 END IF
420 END IF
421*
422 RETURN
423*
424* End of ZTBMV
425*

◆ ztbsv()

subroutine ztbsv ( character uplo,
character trans,
character diag,
integer n,
integer k,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx )

ZTBSV

Purpose:
!>
!> ZTBSV  solves one of the systems of equations
!>
!>    A*x = b,   or   A**T*x = b,   or   A**H*x = b,
!>
!> where b and x are n element vectors and A is an n by n unit, or
!> non-unit, upper or lower triangular band matrix, with ( k + 1 )
!> diagonals.
!>
!> No test for singularity or near-singularity is included in this
!> routine. Such tests must be performed before calling this routine.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the matrix is an upper or
!>           lower triangular matrix as follows:
!>
!>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
!>
!>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the equations to be solved as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   A*x = b.
!>
!>              TRANS = 'T' or 't'   A**T*x = b.
!>
!>              TRANS = 'C' or 'c'   A**H*x = b.
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>           On entry, DIAG specifies whether or not A is unit
!>           triangular as follows:
!>
!>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
!>
!>              DIAG = 'N' or 'n'   A is not assumed to be unit
!>                                  triangular.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]K
!>          K is INTEGER
!>           On entry with UPLO = 'U' or 'u', K specifies the number of
!>           super-diagonals of the matrix A.
!>           On entry with UPLO = 'L' or 'l', K specifies the number of
!>           sub-diagonals of the matrix A.
!>           K must satisfy  0 .le. K.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry with UPLO = 'U' or 'u', the leading ( k + 1 )
!>           by n part of the array A must contain the upper triangular
!>           band part of the matrix of coefficients, supplied column by
!>           column, with the leading diagonal of the matrix in row
!>           ( k + 1 ) of the array, the first super-diagonal starting at
!>           position 2 in row k, and so on. The top left k by k triangle
!>           of the array A is not referenced.
!>           The following program segment will transfer an upper
!>           triangular band matrix from conventional full matrix storage
!>           to band storage:
!>
!>                 DO 20, J = 1, N
!>                    M = K + 1 - J
!>                    DO 10, I = MAX( 1, J - K ), J
!>                       A( M + I, J ) = matrix( I, J )
!>              10    CONTINUE
!>              20 CONTINUE
!>
!>           Before entry with UPLO = 'L' or 'l', the leading ( k + 1 )
!>           by n part of the array A must contain the lower triangular
!>           band part of the matrix of coefficients, supplied column by
!>           column, with the leading diagonal of the matrix in row 1 of
!>           the array, the first sub-diagonal starting at position 1 in
!>           row 2, and so on. The bottom right k by k triangle of the
!>           array A is not referenced.
!>           The following program segment will transfer a lower
!>           triangular band matrix from conventional full matrix storage
!>           to band storage:
!>
!>                 DO 20, J = 1, N
!>                    M = 1 - J
!>                    DO 10, I = J, MIN( N, J + K )
!>                       A( M + I, J ) = matrix( I, J )
!>              10    CONTINUE
!>              20 CONTINUE
!>
!>           Note that when DIAG = 'U' or 'u' the elements of the array A
!>           corresponding to the diagonal elements of the matrix are not
!>           referenced, but are assumed to be unity.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           ( k + 1 ).
!>
[in,out]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element right-hand side vector b. On exit, X is overwritten
!>           with the solution vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 188 of file ztbsv.f.

189*
190* -- Reference BLAS level2 routine --
191* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
192* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
193*
194* .. Scalar Arguments ..
195 INTEGER INCX,K,LDA,N
196 CHARACTER DIAG,TRANS,UPLO
197* ..
198* .. Array Arguments ..
199 COMPLEX*16 A(LDA,*),X(*)
200* ..
201*
202* =====================================================================
203*
204* .. Parameters ..
205 COMPLEX*16 ZERO
206 parameter(zero= (0.0d+0,0.0d+0))
207* ..
208* .. Local Scalars ..
209 COMPLEX*16 TEMP
210 INTEGER I,INFO,IX,J,JX,KPLUS1,KX,L
211 LOGICAL NOCONJ,NOUNIT
212* ..
213* .. External Functions ..
214 LOGICAL LSAME
215 EXTERNAL lsame
216* ..
217* .. External Subroutines ..
218 EXTERNAL xerbla
219* ..
220* .. Intrinsic Functions ..
221 INTRINSIC dconjg,max,min
222* ..
223*
224* Test the input parameters.
225*
226 info = 0
227 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
228 info = 1
229 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
230 + .NOT.lsame(trans,'C')) THEN
231 info = 2
232 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
233 info = 3
234 ELSE IF (n.LT.0) THEN
235 info = 4
236 ELSE IF (k.LT.0) THEN
237 info = 5
238 ELSE IF (lda.LT. (k+1)) THEN
239 info = 7
240 ELSE IF (incx.EQ.0) THEN
241 info = 9
242 END IF
243 IF (info.NE.0) THEN
244 CALL xerbla('ZTBSV ',info)
245 RETURN
246 END IF
247*
248* Quick return if possible.
249*
250 IF (n.EQ.0) RETURN
251*
252 noconj = lsame(trans,'T')
253 nounit = lsame(diag,'N')
254*
255* Set up the start point in X if the increment is not unity. This
256* will be ( N - 1 )*INCX too small for descending loops.
257*
258 IF (incx.LE.0) THEN
259 kx = 1 - (n-1)*incx
260 ELSE IF (incx.NE.1) THEN
261 kx = 1
262 END IF
263*
264* Start the operations. In this version the elements of A are
265* accessed by sequentially with one pass through A.
266*
267 IF (lsame(trans,'N')) THEN
268*
269* Form x := inv( A )*x.
270*
271 IF (lsame(uplo,'U')) THEN
272 kplus1 = k + 1
273 IF (incx.EQ.1) THEN
274 DO 20 j = n,1,-1
275 IF (x(j).NE.zero) THEN
276 l = kplus1 - j
277 IF (nounit) x(j) = x(j)/a(kplus1,j)
278 temp = x(j)
279 DO 10 i = j - 1,max(1,j-k),-1
280 x(i) = x(i) - temp*a(l+i,j)
281 10 CONTINUE
282 END IF
283 20 CONTINUE
284 ELSE
285 kx = kx + (n-1)*incx
286 jx = kx
287 DO 40 j = n,1,-1
288 kx = kx - incx
289 IF (x(jx).NE.zero) THEN
290 ix = kx
291 l = kplus1 - j
292 IF (nounit) x(jx) = x(jx)/a(kplus1,j)
293 temp = x(jx)
294 DO 30 i = j - 1,max(1,j-k),-1
295 x(ix) = x(ix) - temp*a(l+i,j)
296 ix = ix - incx
297 30 CONTINUE
298 END IF
299 jx = jx - incx
300 40 CONTINUE
301 END IF
302 ELSE
303 IF (incx.EQ.1) THEN
304 DO 60 j = 1,n
305 IF (x(j).NE.zero) THEN
306 l = 1 - j
307 IF (nounit) x(j) = x(j)/a(1,j)
308 temp = x(j)
309 DO 50 i = j + 1,min(n,j+k)
310 x(i) = x(i) - temp*a(l+i,j)
311 50 CONTINUE
312 END IF
313 60 CONTINUE
314 ELSE
315 jx = kx
316 DO 80 j = 1,n
317 kx = kx + incx
318 IF (x(jx).NE.zero) THEN
319 ix = kx
320 l = 1 - j
321 IF (nounit) x(jx) = x(jx)/a(1,j)
322 temp = x(jx)
323 DO 70 i = j + 1,min(n,j+k)
324 x(ix) = x(ix) - temp*a(l+i,j)
325 ix = ix + incx
326 70 CONTINUE
327 END IF
328 jx = jx + incx
329 80 CONTINUE
330 END IF
331 END IF
332 ELSE
333*
334* Form x := inv( A**T )*x or x := inv( A**H )*x.
335*
336 IF (lsame(uplo,'U')) THEN
337 kplus1 = k + 1
338 IF (incx.EQ.1) THEN
339 DO 110 j = 1,n
340 temp = x(j)
341 l = kplus1 - j
342 IF (noconj) THEN
343 DO 90 i = max(1,j-k),j - 1
344 temp = temp - a(l+i,j)*x(i)
345 90 CONTINUE
346 IF (nounit) temp = temp/a(kplus1,j)
347 ELSE
348 DO 100 i = max(1,j-k),j - 1
349 temp = temp - dconjg(a(l+i,j))*x(i)
350 100 CONTINUE
351 IF (nounit) temp = temp/dconjg(a(kplus1,j))
352 END IF
353 x(j) = temp
354 110 CONTINUE
355 ELSE
356 jx = kx
357 DO 140 j = 1,n
358 temp = x(jx)
359 ix = kx
360 l = kplus1 - j
361 IF (noconj) THEN
362 DO 120 i = max(1,j-k),j - 1
363 temp = temp - a(l+i,j)*x(ix)
364 ix = ix + incx
365 120 CONTINUE
366 IF (nounit) temp = temp/a(kplus1,j)
367 ELSE
368 DO 130 i = max(1,j-k),j - 1
369 temp = temp - dconjg(a(l+i,j))*x(ix)
370 ix = ix + incx
371 130 CONTINUE
372 IF (nounit) temp = temp/dconjg(a(kplus1,j))
373 END IF
374 x(jx) = temp
375 jx = jx + incx
376 IF (j.GT.k) kx = kx + incx
377 140 CONTINUE
378 END IF
379 ELSE
380 IF (incx.EQ.1) THEN
381 DO 170 j = n,1,-1
382 temp = x(j)
383 l = 1 - j
384 IF (noconj) THEN
385 DO 150 i = min(n,j+k),j + 1,-1
386 temp = temp - a(l+i,j)*x(i)
387 150 CONTINUE
388 IF (nounit) temp = temp/a(1,j)
389 ELSE
390 DO 160 i = min(n,j+k),j + 1,-1
391 temp = temp - dconjg(a(l+i,j))*x(i)
392 160 CONTINUE
393 IF (nounit) temp = temp/dconjg(a(1,j))
394 END IF
395 x(j) = temp
396 170 CONTINUE
397 ELSE
398 kx = kx + (n-1)*incx
399 jx = kx
400 DO 200 j = n,1,-1
401 temp = x(jx)
402 ix = kx
403 l = 1 - j
404 IF (noconj) THEN
405 DO 180 i = min(n,j+k),j + 1,-1
406 temp = temp - a(l+i,j)*x(ix)
407 ix = ix - incx
408 180 CONTINUE
409 IF (nounit) temp = temp/a(1,j)
410 ELSE
411 DO 190 i = min(n,j+k),j + 1,-1
412 temp = temp - dconjg(a(l+i,j))*x(ix)
413 ix = ix - incx
414 190 CONTINUE
415 IF (nounit) temp = temp/dconjg(a(1,j))
416 END IF
417 x(jx) = temp
418 jx = jx - incx
419 IF ((n-j).GE.k) kx = kx - incx
420 200 CONTINUE
421 END IF
422 END IF
423 END IF
424*
425 RETURN
426*
427* End of ZTBSV
428*

◆ ztpmv()

subroutine ztpmv ( character uplo,
character trans,
character diag,
integer n,
complex*16, dimension(*) ap,
complex*16, dimension(*) x,
integer incx )

ZTPMV

Purpose:
!>
!> ZTPMV  performs one of the matrix-vector operations
!>
!>    x := A*x,   or   x := A**T*x,   or   x := A**H*x,
!>
!> where x is an n element vector and  A is an n by n unit, or non-unit,
!> upper or lower triangular matrix, supplied in packed form.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the matrix is an upper or
!>           lower triangular matrix as follows:
!>
!>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
!>
!>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the operation to be performed as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   x := A*x.
!>
!>              TRANS = 'T' or 't'   x := A**T*x.
!>
!>              TRANS = 'C' or 'c'   x := A**H*x.
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>           On entry, DIAG specifies whether or not A is unit
!>           triangular as follows:
!>
!>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
!>
!>              DIAG = 'N' or 'n'   A is not assumed to be unit
!>                                  triangular.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]AP
!>          AP is COMPLEX*16 array, dimension at least
!>           ( ( n*( n + 1 ) )/2 ).
!>           Before entry with  UPLO = 'U' or 'u', the array AP must
!>           contain the upper triangular matrix packed sequentially,
!>           column by column, so that AP( 1 ) contains a( 1, 1 ),
!>           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
!>           respectively, and so on.
!>           Before entry with UPLO = 'L' or 'l', the array AP must
!>           contain the lower triangular matrix packed sequentially,
!>           column by column, so that AP( 1 ) contains a( 1, 1 ),
!>           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
!>           respectively, and so on.
!>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
!>           A are not referenced, but are assumed to be unity.
!>
[in,out]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x. On exit, X is overwritten with the
!>           transformed vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 141 of file ztpmv.f.

142*
143* -- Reference BLAS level2 routine --
144* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
145* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
146*
147* .. Scalar Arguments ..
148 INTEGER INCX,N
149 CHARACTER DIAG,TRANS,UPLO
150* ..
151* .. Array Arguments ..
152 COMPLEX*16 AP(*),X(*)
153* ..
154*
155* =====================================================================
156*
157* .. Parameters ..
158 COMPLEX*16 ZERO
159 parameter(zero= (0.0d+0,0.0d+0))
160* ..
161* .. Local Scalars ..
162 COMPLEX*16 TEMP
163 INTEGER I,INFO,IX,J,JX,K,KK,KX
164 LOGICAL NOCONJ,NOUNIT
165* ..
166* .. External Functions ..
167 LOGICAL LSAME
168 EXTERNAL lsame
169* ..
170* .. External Subroutines ..
171 EXTERNAL xerbla
172* ..
173* .. Intrinsic Functions ..
174 INTRINSIC dconjg
175* ..
176*
177* Test the input parameters.
178*
179 info = 0
180 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
181 info = 1
182 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
183 + .NOT.lsame(trans,'C')) THEN
184 info = 2
185 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
186 info = 3
187 ELSE IF (n.LT.0) THEN
188 info = 4
189 ELSE IF (incx.EQ.0) THEN
190 info = 7
191 END IF
192 IF (info.NE.0) THEN
193 CALL xerbla('ZTPMV ',info)
194 RETURN
195 END IF
196*
197* Quick return if possible.
198*
199 IF (n.EQ.0) RETURN
200*
201 noconj = lsame(trans,'T')
202 nounit = lsame(diag,'N')
203*
204* Set up the start point in X if the increment is not unity. This
205* will be ( N - 1 )*INCX too small for descending loops.
206*
207 IF (incx.LE.0) THEN
208 kx = 1 - (n-1)*incx
209 ELSE IF (incx.NE.1) THEN
210 kx = 1
211 END IF
212*
213* Start the operations. In this version the elements of AP are
214* accessed sequentially with one pass through AP.
215*
216 IF (lsame(trans,'N')) THEN
217*
218* Form x:= A*x.
219*
220 IF (lsame(uplo,'U')) THEN
221 kk = 1
222 IF (incx.EQ.1) THEN
223 DO 20 j = 1,n
224 IF (x(j).NE.zero) THEN
225 temp = x(j)
226 k = kk
227 DO 10 i = 1,j - 1
228 x(i) = x(i) + temp*ap(k)
229 k = k + 1
230 10 CONTINUE
231 IF (nounit) x(j) = x(j)*ap(kk+j-1)
232 END IF
233 kk = kk + j
234 20 CONTINUE
235 ELSE
236 jx = kx
237 DO 40 j = 1,n
238 IF (x(jx).NE.zero) THEN
239 temp = x(jx)
240 ix = kx
241 DO 30 k = kk,kk + j - 2
242 x(ix) = x(ix) + temp*ap(k)
243 ix = ix + incx
244 30 CONTINUE
245 IF (nounit) x(jx) = x(jx)*ap(kk+j-1)
246 END IF
247 jx = jx + incx
248 kk = kk + j
249 40 CONTINUE
250 END IF
251 ELSE
252 kk = (n* (n+1))/2
253 IF (incx.EQ.1) THEN
254 DO 60 j = n,1,-1
255 IF (x(j).NE.zero) THEN
256 temp = x(j)
257 k = kk
258 DO 50 i = n,j + 1,-1
259 x(i) = x(i) + temp*ap(k)
260 k = k - 1
261 50 CONTINUE
262 IF (nounit) x(j) = x(j)*ap(kk-n+j)
263 END IF
264 kk = kk - (n-j+1)
265 60 CONTINUE
266 ELSE
267 kx = kx + (n-1)*incx
268 jx = kx
269 DO 80 j = n,1,-1
270 IF (x(jx).NE.zero) THEN
271 temp = x(jx)
272 ix = kx
273 DO 70 k = kk,kk - (n- (j+1)),-1
274 x(ix) = x(ix) + temp*ap(k)
275 ix = ix - incx
276 70 CONTINUE
277 IF (nounit) x(jx) = x(jx)*ap(kk-n+j)
278 END IF
279 jx = jx - incx
280 kk = kk - (n-j+1)
281 80 CONTINUE
282 END IF
283 END IF
284 ELSE
285*
286* Form x := A**T*x or x := A**H*x.
287*
288 IF (lsame(uplo,'U')) THEN
289 kk = (n* (n+1))/2
290 IF (incx.EQ.1) THEN
291 DO 110 j = n,1,-1
292 temp = x(j)
293 k = kk - 1
294 IF (noconj) THEN
295 IF (nounit) temp = temp*ap(kk)
296 DO 90 i = j - 1,1,-1
297 temp = temp + ap(k)*x(i)
298 k = k - 1
299 90 CONTINUE
300 ELSE
301 IF (nounit) temp = temp*dconjg(ap(kk))
302 DO 100 i = j - 1,1,-1
303 temp = temp + dconjg(ap(k))*x(i)
304 k = k - 1
305 100 CONTINUE
306 END IF
307 x(j) = temp
308 kk = kk - j
309 110 CONTINUE
310 ELSE
311 jx = kx + (n-1)*incx
312 DO 140 j = n,1,-1
313 temp = x(jx)
314 ix = jx
315 IF (noconj) THEN
316 IF (nounit) temp = temp*ap(kk)
317 DO 120 k = kk - 1,kk - j + 1,-1
318 ix = ix - incx
319 temp = temp + ap(k)*x(ix)
320 120 CONTINUE
321 ELSE
322 IF (nounit) temp = temp*dconjg(ap(kk))
323 DO 130 k = kk - 1,kk - j + 1,-1
324 ix = ix - incx
325 temp = temp + dconjg(ap(k))*x(ix)
326 130 CONTINUE
327 END IF
328 x(jx) = temp
329 jx = jx - incx
330 kk = kk - j
331 140 CONTINUE
332 END IF
333 ELSE
334 kk = 1
335 IF (incx.EQ.1) THEN
336 DO 170 j = 1,n
337 temp = x(j)
338 k = kk + 1
339 IF (noconj) THEN
340 IF (nounit) temp = temp*ap(kk)
341 DO 150 i = j + 1,n
342 temp = temp + ap(k)*x(i)
343 k = k + 1
344 150 CONTINUE
345 ELSE
346 IF (nounit) temp = temp*dconjg(ap(kk))
347 DO 160 i = j + 1,n
348 temp = temp + dconjg(ap(k))*x(i)
349 k = k + 1
350 160 CONTINUE
351 END IF
352 x(j) = temp
353 kk = kk + (n-j+1)
354 170 CONTINUE
355 ELSE
356 jx = kx
357 DO 200 j = 1,n
358 temp = x(jx)
359 ix = jx
360 IF (noconj) THEN
361 IF (nounit) temp = temp*ap(kk)
362 DO 180 k = kk + 1,kk + n - j
363 ix = ix + incx
364 temp = temp + ap(k)*x(ix)
365 180 CONTINUE
366 ELSE
367 IF (nounit) temp = temp*dconjg(ap(kk))
368 DO 190 k = kk + 1,kk + n - j
369 ix = ix + incx
370 temp = temp + dconjg(ap(k))*x(ix)
371 190 CONTINUE
372 END IF
373 x(jx) = temp
374 jx = jx + incx
375 kk = kk + (n-j+1)
376 200 CONTINUE
377 END IF
378 END IF
379 END IF
380*
381 RETURN
382*
383* End of ZTPMV
384*

◆ ztpsv()

subroutine ztpsv ( character uplo,
character trans,
character diag,
integer n,
complex*16, dimension(*) ap,
complex*16, dimension(*) x,
integer incx )

ZTPSV

Purpose:
!>
!> ZTPSV  solves one of the systems of equations
!>
!>    A*x = b,   or   A**T*x = b,   or   A**H*x = b,
!>
!> where b and x are n element vectors and A is an n by n unit, or
!> non-unit, upper or lower triangular matrix, supplied in packed form.
!>
!> No test for singularity or near-singularity is included in this
!> routine. Such tests must be performed before calling this routine.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the matrix is an upper or
!>           lower triangular matrix as follows:
!>
!>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
!>
!>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the equations to be solved as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   A*x = b.
!>
!>              TRANS = 'T' or 't'   A**T*x = b.
!>
!>              TRANS = 'C' or 'c'   A**H*x = b.
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>           On entry, DIAG specifies whether or not A is unit
!>           triangular as follows:
!>
!>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
!>
!>              DIAG = 'N' or 'n'   A is not assumed to be unit
!>                                  triangular.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]AP
!>          AP is COMPLEX*16 array, dimension at least
!>           ( ( n*( n + 1 ) )/2 ).
!>           Before entry with  UPLO = 'U' or 'u', the array AP must
!>           contain the upper triangular matrix packed sequentially,
!>           column by column, so that AP( 1 ) contains a( 1, 1 ),
!>           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
!>           respectively, and so on.
!>           Before entry with UPLO = 'L' or 'l', the array AP must
!>           contain the lower triangular matrix packed sequentially,
!>           column by column, so that AP( 1 ) contains a( 1, 1 ),
!>           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
!>           respectively, and so on.
!>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
!>           A are not referenced, but are assumed to be unity.
!>
[in,out]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element right-hand side vector b. On exit, X is overwritten
!>           with the solution vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 143 of file ztpsv.f.

144*
145* -- Reference BLAS level2 routine --
146* -- Reference BLAS is a software package provided by Univ. of Tennessee, --
147* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148*
149* .. Scalar Arguments ..
150 INTEGER INCX,N
151 CHARACTER DIAG,TRANS,UPLO
152* ..
153* .. Array Arguments ..
154 COMPLEX*16 AP(*),X(*)
155* ..
156*
157* =====================================================================
158*
159* .. Parameters ..
160 COMPLEX*16 ZERO
161 parameter(zero= (0.0d+0,0.0d+0))
162* ..
163* .. Local Scalars ..
164 COMPLEX*16 TEMP
165 INTEGER I,INFO,IX,J,JX,K,KK,KX
166 LOGICAL NOCONJ,NOUNIT
167* ..
168* .. External Functions ..
169 LOGICAL LSAME
170 EXTERNAL lsame
171* ..
172* .. External Subroutines ..
173 EXTERNAL xerbla
174* ..
175* .. Intrinsic Functions ..
176 INTRINSIC dconjg
177* ..
178*
179* Test the input parameters.
180*
181 info = 0
182 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
183 info = 1
184 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
185 + .NOT.lsame(trans,'C')) THEN
186 info = 2
187 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
188 info = 3
189 ELSE IF (n.LT.0) THEN
190 info = 4
191 ELSE IF (incx.EQ.0) THEN
192 info = 7
193 END IF
194 IF (info.NE.0) THEN
195 CALL xerbla('ZTPSV ',info)
196 RETURN
197 END IF
198*
199* Quick return if possible.
200*
201 IF (n.EQ.0) RETURN
202*
203 noconj = lsame(trans,'T')
204 nounit = lsame(diag,'N')
205*
206* Set up the start point in X if the increment is not unity. This
207* will be ( N - 1 )*INCX too small for descending loops.
208*
209 IF (incx.LE.0) THEN
210 kx = 1 - (n-1)*incx
211 ELSE IF (incx.NE.1) THEN
212 kx = 1
213 END IF
214*
215* Start the operations. In this version the elements of AP are
216* accessed sequentially with one pass through AP.
217*
218 IF (lsame(trans,'N')) THEN
219*
220* Form x := inv( A )*x.
221*
222 IF (lsame(uplo,'U')) THEN
223 kk = (n* (n+1))/2
224 IF (incx.EQ.1) THEN
225 DO 20 j = n,1,-1
226 IF (x(j).NE.zero) THEN
227 IF (nounit) x(j) = x(j)/ap(kk)
228 temp = x(j)
229 k = kk - 1
230 DO 10 i = j - 1,1,-1
231 x(i) = x(i) - temp*ap(k)
232 k = k - 1
233 10 CONTINUE
234 END IF
235 kk = kk - j
236 20 CONTINUE
237 ELSE
238 jx = kx + (n-1)*incx
239 DO 40 j = n,1,-1
240 IF (x(jx).NE.zero) THEN
241 IF (nounit) x(jx) = x(jx)/ap(kk)
242 temp = x(jx)
243 ix = jx
244 DO 30 k = kk - 1,kk - j + 1,-1
245 ix = ix - incx
246 x(ix) = x(ix) - temp*ap(k)
247 30 CONTINUE
248 END IF
249 jx = jx - incx
250 kk = kk - j
251 40 CONTINUE
252 END IF
253 ELSE
254 kk = 1
255 IF (incx.EQ.1) THEN
256 DO 60 j = 1,n
257 IF (x(j).NE.zero) THEN
258 IF (nounit) x(j) = x(j)/ap(kk)
259 temp = x(j)
260 k = kk + 1
261 DO 50 i = j + 1,n
262 x(i) = x(i) - temp*ap(k)
263 k = k + 1
264 50 CONTINUE
265 END IF
266 kk = kk + (n-j+1)
267 60 CONTINUE
268 ELSE
269 jx = kx
270 DO 80 j = 1,n
271 IF (x(jx).NE.zero) THEN
272 IF (nounit) x(jx) = x(jx)/ap(kk)
273 temp = x(jx)
274 ix = jx
275 DO 70 k = kk + 1,kk + n - j
276 ix = ix + incx
277 x(ix) = x(ix) - temp*ap(k)
278 70 CONTINUE
279 END IF
280 jx = jx + incx
281 kk = kk + (n-j+1)
282 80 CONTINUE
283 END IF
284 END IF
285 ELSE
286*
287* Form x := inv( A**T )*x or x := inv( A**H )*x.
288*
289 IF (lsame(uplo,'U')) THEN
290 kk = 1
291 IF (incx.EQ.1) THEN
292 DO 110 j = 1,n
293 temp = x(j)
294 k = kk
295 IF (noconj) THEN
296 DO 90 i = 1,j - 1
297 temp = temp - ap(k)*x(i)
298 k = k + 1
299 90 CONTINUE
300 IF (nounit) temp = temp/ap(kk+j-1)
301 ELSE
302 DO 100 i = 1,j - 1
303 temp = temp - dconjg(ap(k))*x(i)
304 k = k + 1
305 100 CONTINUE
306 IF (nounit) temp = temp/dconjg(ap(kk+j-1))
307 END IF
308 x(j) = temp
309 kk = kk + j
310 110 CONTINUE
311 ELSE
312 jx = kx
313 DO 140 j = 1,n
314 temp = x(jx)
315 ix = kx
316 IF (noconj) THEN
317 DO 120 k = kk,kk + j - 2
318 temp = temp - ap(k)*x(ix)
319 ix = ix + incx
320 120 CONTINUE
321 IF (nounit) temp = temp/ap(kk+j-1)
322 ELSE
323 DO 130 k = kk,kk + j - 2
324 temp = temp - dconjg(ap(k))*x(ix)
325 ix = ix + incx
326 130 CONTINUE
327 IF (nounit) temp = temp/dconjg(ap(kk+j-1))
328 END IF
329 x(jx) = temp
330 jx = jx + incx
331 kk = kk + j
332 140 CONTINUE
333 END IF
334 ELSE
335 kk = (n* (n+1))/2
336 IF (incx.EQ.1) THEN
337 DO 170 j = n,1,-1
338 temp = x(j)
339 k = kk
340 IF (noconj) THEN
341 DO 150 i = n,j + 1,-1
342 temp = temp - ap(k)*x(i)
343 k = k - 1
344 150 CONTINUE
345 IF (nounit) temp = temp/ap(kk-n+j)
346 ELSE
347 DO 160 i = n,j + 1,-1
348 temp = temp - dconjg(ap(k))*x(i)
349 k = k - 1
350 160 CONTINUE
351 IF (nounit) temp = temp/dconjg(ap(kk-n+j))
352 END IF
353 x(j) = temp
354 kk = kk - (n-j+1)
355 170 CONTINUE
356 ELSE
357 kx = kx + (n-1)*incx
358 jx = kx
359 DO 200 j = n,1,-1
360 temp = x(jx)
361 ix = kx
362 IF (noconj) THEN
363 DO 180 k = kk,kk - (n- (j+1)),-1
364 temp = temp - ap(k)*x(ix)
365 ix = ix - incx
366 180 CONTINUE
367 IF (nounit) temp = temp/ap(kk-n+j)
368 ELSE
369 DO 190 k = kk,kk - (n- (j+1)),-1
370 temp = temp - dconjg(ap(k))*x(ix)
371 ix = ix - incx
372 190 CONTINUE
373 IF (nounit) temp = temp/dconjg(ap(kk-n+j))
374 END IF
375 x(jx) = temp
376 jx = jx - incx
377 kk = kk - (n-j+1)
378 200 CONTINUE
379 END IF
380 END IF
381 END IF
382*
383 RETURN
384*
385* End of ZTPSV
386*

◆ ztrmv()

subroutine ztrmv ( character uplo,
character trans,
character diag,
integer n,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx )

ZTRMV

Purpose:
!>
!> ZTRMV  performs one of the matrix-vector operations
!>
!>    x := A*x,   or   x := A**T*x,   or   x := A**H*x,
!>
!> where x is an n element vector and  A is an n by n unit, or non-unit,
!> upper or lower triangular matrix.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the matrix is an upper or
!>           lower triangular matrix as follows:
!>
!>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
!>
!>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the operation to be performed as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   x := A*x.
!>
!>              TRANS = 'T' or 't'   x := A**T*x.
!>
!>              TRANS = 'C' or 'c'   x := A**H*x.
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>           On entry, DIAG specifies whether or not A is unit
!>           triangular as follows:
!>
!>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
!>
!>              DIAG = 'N' or 'n'   A is not assumed to be unit
!>                                  triangular.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N ).
!>           Before entry with  UPLO = 'U' or 'u', the leading n by n
!>           upper triangular part of the array A must contain the upper
!>           triangular matrix and the strictly lower triangular part of
!>           A is not referenced.
!>           Before entry with UPLO = 'L' or 'l', the leading n by n
!>           lower triangular part of the array A must contain the lower
!>           triangular matrix and the strictly upper triangular part of
!>           A is not referenced.
!>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
!>           A are not referenced either, but are assumed to be unity.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, n ).
!>
[in,out]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element vector x. On exit, X is overwritten with the
!>           transformed vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>  The vector and matrix arguments are not referenced when N = 0, or M = 0
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 146 of file ztrmv.f.

147*
148* -- Reference BLAS level2 routine --
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*
152* .. Scalar Arguments ..
153 INTEGER INCX,LDA,N
154 CHARACTER DIAG,TRANS,UPLO
155* ..
156* .. Array Arguments ..
157 COMPLEX*16 A(LDA,*),X(*)
158* ..
159*
160* =====================================================================
161*
162* .. Parameters ..
163 COMPLEX*16 ZERO
164 parameter(zero= (0.0d+0,0.0d+0))
165* ..
166* .. Local Scalars ..
167 COMPLEX*16 TEMP
168 INTEGER I,INFO,IX,J,JX,KX
169 LOGICAL NOCONJ,NOUNIT
170* ..
171* .. External Functions ..
172 LOGICAL LSAME
173 EXTERNAL lsame
174* ..
175* .. External Subroutines ..
176 EXTERNAL xerbla
177* ..
178* .. Intrinsic Functions ..
179 INTRINSIC dconjg,max
180* ..
181*
182* Test the input parameters.
183*
184 info = 0
185 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
186 info = 1
187 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
188 + .NOT.lsame(trans,'C')) THEN
189 info = 2
190 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
191 info = 3
192 ELSE IF (n.LT.0) THEN
193 info = 4
194 ELSE IF (lda.LT.max(1,n)) THEN
195 info = 6
196 ELSE IF (incx.EQ.0) THEN
197 info = 8
198 END IF
199 IF (info.NE.0) THEN
200 CALL xerbla('ZTRMV ',info)
201 RETURN
202 END IF
203*
204* Quick return if possible.
205*
206 IF (n.EQ.0) RETURN
207*
208 noconj = lsame(trans,'T')
209 nounit = lsame(diag,'N')
210*
211* Set up the start point in X if the increment is not unity. This
212* will be ( N - 1 )*INCX too small for descending loops.
213*
214 IF (incx.LE.0) THEN
215 kx = 1 - (n-1)*incx
216 ELSE IF (incx.NE.1) THEN
217 kx = 1
218 END IF
219*
220* Start the operations. In this version the elements of A are
221* accessed sequentially with one pass through A.
222*
223 IF (lsame(trans,'N')) THEN
224*
225* Form x := A*x.
226*
227 IF (lsame(uplo,'U')) THEN
228 IF (incx.EQ.1) THEN
229 DO 20 j = 1,n
230 IF (x(j).NE.zero) THEN
231 temp = x(j)
232 DO 10 i = 1,j - 1
233 x(i) = x(i) + temp*a(i,j)
234 10 CONTINUE
235 IF (nounit) x(j) = x(j)*a(j,j)
236 END IF
237 20 CONTINUE
238 ELSE
239 jx = kx
240 DO 40 j = 1,n
241 IF (x(jx).NE.zero) THEN
242 temp = x(jx)
243 ix = kx
244 DO 30 i = 1,j - 1
245 x(ix) = x(ix) + temp*a(i,j)
246 ix = ix + incx
247 30 CONTINUE
248 IF (nounit) x(jx) = x(jx)*a(j,j)
249 END IF
250 jx = jx + incx
251 40 CONTINUE
252 END IF
253 ELSE
254 IF (incx.EQ.1) THEN
255 DO 60 j = n,1,-1
256 IF (x(j).NE.zero) THEN
257 temp = x(j)
258 DO 50 i = n,j + 1,-1
259 x(i) = x(i) + temp*a(i,j)
260 50 CONTINUE
261 IF (nounit) x(j) = x(j)*a(j,j)
262 END IF
263 60 CONTINUE
264 ELSE
265 kx = kx + (n-1)*incx
266 jx = kx
267 DO 80 j = n,1,-1
268 IF (x(jx).NE.zero) THEN
269 temp = x(jx)
270 ix = kx
271 DO 70 i = n,j + 1,-1
272 x(ix) = x(ix) + temp*a(i,j)
273 ix = ix - incx
274 70 CONTINUE
275 IF (nounit) x(jx) = x(jx)*a(j,j)
276 END IF
277 jx = jx - incx
278 80 CONTINUE
279 END IF
280 END IF
281 ELSE
282*
283* Form x := A**T*x or x := A**H*x.
284*
285 IF (lsame(uplo,'U')) THEN
286 IF (incx.EQ.1) THEN
287 DO 110 j = n,1,-1
288 temp = x(j)
289 IF (noconj) THEN
290 IF (nounit) temp = temp*a(j,j)
291 DO 90 i = j - 1,1,-1
292 temp = temp + a(i,j)*x(i)
293 90 CONTINUE
294 ELSE
295 IF (nounit) temp = temp*dconjg(a(j,j))
296 DO 100 i = j - 1,1,-1
297 temp = temp + dconjg(a(i,j))*x(i)
298 100 CONTINUE
299 END IF
300 x(j) = temp
301 110 CONTINUE
302 ELSE
303 jx = kx + (n-1)*incx
304 DO 140 j = n,1,-1
305 temp = x(jx)
306 ix = jx
307 IF (noconj) THEN
308 IF (nounit) temp = temp*a(j,j)
309 DO 120 i = j - 1,1,-1
310 ix = ix - incx
311 temp = temp + a(i,j)*x(ix)
312 120 CONTINUE
313 ELSE
314 IF (nounit) temp = temp*dconjg(a(j,j))
315 DO 130 i = j - 1,1,-1
316 ix = ix - incx
317 temp = temp + dconjg(a(i,j))*x(ix)
318 130 CONTINUE
319 END IF
320 x(jx) = temp
321 jx = jx - incx
322 140 CONTINUE
323 END IF
324 ELSE
325 IF (incx.EQ.1) THEN
326 DO 170 j = 1,n
327 temp = x(j)
328 IF (noconj) THEN
329 IF (nounit) temp = temp*a(j,j)
330 DO 150 i = j + 1,n
331 temp = temp + a(i,j)*x(i)
332 150 CONTINUE
333 ELSE
334 IF (nounit) temp = temp*dconjg(a(j,j))
335 DO 160 i = j + 1,n
336 temp = temp + dconjg(a(i,j))*x(i)
337 160 CONTINUE
338 END IF
339 x(j) = temp
340 170 CONTINUE
341 ELSE
342 jx = kx
343 DO 200 j = 1,n
344 temp = x(jx)
345 ix = jx
346 IF (noconj) THEN
347 IF (nounit) temp = temp*a(j,j)
348 DO 180 i = j + 1,n
349 ix = ix + incx
350 temp = temp + a(i,j)*x(ix)
351 180 CONTINUE
352 ELSE
353 IF (nounit) temp = temp*dconjg(a(j,j))
354 DO 190 i = j + 1,n
355 ix = ix + incx
356 temp = temp + dconjg(a(i,j))*x(ix)
357 190 CONTINUE
358 END IF
359 x(jx) = temp
360 jx = jx + incx
361 200 CONTINUE
362 END IF
363 END IF
364 END IF
365*
366 RETURN
367*
368* End of ZTRMV
369*

◆ ztrsv()

subroutine ztrsv ( character uplo,
character trans,
character diag,
integer n,
complex*16, dimension(lda,*) a,
integer lda,
complex*16, dimension(*) x,
integer incx )

ZTRSV

Purpose:
!>
!> ZTRSV  solves one of the systems of equations
!>
!>    A*x = b,   or   A**T*x = b,   or   A**H*x = b,
!>
!> where b and x are n element vectors and A is an n by n unit, or
!> non-unit, upper or lower triangular matrix.
!>
!> No test for singularity or near-singularity is included in this
!> routine. Such tests must be performed before calling this routine.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>           On entry, UPLO specifies whether the matrix is an upper or
!>           lower triangular matrix as follows:
!>
!>              UPLO = 'U' or 'u'   A is an upper triangular matrix.
!>
!>              UPLO = 'L' or 'l'   A is a lower triangular matrix.
!>
[in]TRANS
!>          TRANS is CHARACTER*1
!>           On entry, TRANS specifies the equations to be solved as
!>           follows:
!>
!>              TRANS = 'N' or 'n'   A*x = b.
!>
!>              TRANS = 'T' or 't'   A**T*x = b.
!>
!>              TRANS = 'C' or 'c'   A**H*x = b.
!>
[in]DIAG
!>          DIAG is CHARACTER*1
!>           On entry, DIAG specifies whether or not A is unit
!>           triangular as follows:
!>
!>              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
!>
!>              DIAG = 'N' or 'n'   A is not assumed to be unit
!>                                  triangular.
!>
[in]N
!>          N is INTEGER
!>           On entry, N specifies the order of the matrix A.
!>           N must be at least zero.
!>
[in]A
!>          A is COMPLEX*16 array, dimension ( LDA, N )
!>           Before entry with  UPLO = 'U' or 'u', the leading n by n
!>           upper triangular part of the array A must contain the upper
!>           triangular matrix and the strictly lower triangular part of
!>           A is not referenced.
!>           Before entry with UPLO = 'L' or 'l', the leading n by n
!>           lower triangular part of the array A must contain the lower
!>           triangular matrix and the strictly upper triangular part of
!>           A is not referenced.
!>           Note that when  DIAG = 'U' or 'u', the diagonal elements of
!>           A are not referenced either, but are assumed to be unity.
!>
[in]LDA
!>          LDA is INTEGER
!>           On entry, LDA specifies the first dimension of A as declared
!>           in the calling (sub) program. LDA must be at least
!>           max( 1, n ).
!>
[in,out]X
!>          X is COMPLEX*16 array, dimension at least
!>           ( 1 + ( n - 1 )*abs( INCX ) ).
!>           Before entry, the incremented array X must contain the n
!>           element right-hand side vector b. On exit, X is overwritten
!>           with the solution vector x.
!>
[in]INCX
!>          INCX is INTEGER
!>           On entry, INCX specifies the increment for the elements of
!>           X. INCX must not be zero.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
!>
!>  Level 2 Blas routine.
!>
!>  -- Written on 22-October-1986.
!>     Jack Dongarra, Argonne National Lab.
!>     Jeremy Du Croz, Nag Central Office.
!>     Sven Hammarling, Nag Central Office.
!>     Richard Hanson, Sandia National Labs.
!>

Definition at line 148 of file ztrsv.f.

149*
150* -- Reference BLAS level2 routine --
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*
154* .. Scalar Arguments ..
155 INTEGER INCX,LDA,N
156 CHARACTER DIAG,TRANS,UPLO
157* ..
158* .. Array Arguments ..
159 COMPLEX*16 A(LDA,*),X(*)
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 TEMP
170 INTEGER I,INFO,IX,J,JX,KX
171 LOGICAL NOCONJ,NOUNIT
172* ..
173* .. External Functions ..
174 LOGICAL LSAME
175 EXTERNAL lsame
176* ..
177* .. External Subroutines ..
178 EXTERNAL xerbla
179* ..
180* .. Intrinsic Functions ..
181 INTRINSIC dconjg,max
182* ..
183*
184* Test the input parameters.
185*
186 info = 0
187 IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
188 info = 1
189 ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
190 + .NOT.lsame(trans,'C')) THEN
191 info = 2
192 ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
193 info = 3
194 ELSE IF (n.LT.0) THEN
195 info = 4
196 ELSE IF (lda.LT.max(1,n)) THEN
197 info = 6
198 ELSE IF (incx.EQ.0) THEN
199 info = 8
200 END IF
201 IF (info.NE.0) THEN
202 CALL xerbla('ZTRSV ',info)
203 RETURN
204 END IF
205*
206* Quick return if possible.
207*
208 IF (n.EQ.0) RETURN
209*
210 noconj = lsame(trans,'T')
211 nounit = lsame(diag,'N')
212*
213* Set up the start point in X if the increment is not unity. This
214* will be ( N - 1 )*INCX too small for descending loops.
215*
216 IF (incx.LE.0) THEN
217 kx = 1 - (n-1)*incx
218 ELSE IF (incx.NE.1) THEN
219 kx = 1
220 END IF
221*
222* Start the operations. In this version the elements of A are
223* accessed sequentially with one pass through A.
224*
225 IF (lsame(trans,'N')) THEN
226*
227* Form x := inv( A )*x.
228*
229 IF (lsame(uplo,'U')) THEN
230 IF (incx.EQ.1) THEN
231 DO 20 j = n,1,-1
232 IF (x(j).NE.zero) THEN
233 IF (nounit) x(j) = x(j)/a(j,j)
234 temp = x(j)
235 DO 10 i = j - 1,1,-1
236 x(i) = x(i) - temp*a(i,j)
237 10 CONTINUE
238 END IF
239 20 CONTINUE
240 ELSE
241 jx = kx + (n-1)*incx
242 DO 40 j = n,1,-1
243 IF (x(jx).NE.zero) THEN
244 IF (nounit) x(jx) = x(jx)/a(j,j)
245 temp = x(jx)
246 ix = jx
247 DO 30 i = j - 1,1,-1
248 ix = ix - incx
249 x(ix) = x(ix) - temp*a(i,j)
250 30 CONTINUE
251 END IF
252 jx = jx - incx
253 40 CONTINUE
254 END IF
255 ELSE
256 IF (incx.EQ.1) THEN
257 DO 60 j = 1,n
258 IF (x(j).NE.zero) THEN
259 IF (nounit) x(j) = x(j)/a(j,j)
260 temp = x(j)
261 DO 50 i = j + 1,n
262 x(i) = x(i) - temp*a(i,j)
263 50 CONTINUE
264 END IF
265 60 CONTINUE
266 ELSE
267 jx = kx
268 DO 80 j = 1,n
269 IF (x(jx).NE.zero) THEN
270 IF (nounit) x(jx) = x(jx)/a(j,j)
271 temp = x(jx)
272 ix = jx
273 DO 70 i = j + 1,n
274 ix = ix + incx
275 x(ix) = x(ix) - temp*a(i,j)
276 70 CONTINUE
277 END IF
278 jx = jx + incx
279 80 CONTINUE
280 END IF
281 END IF
282 ELSE
283*
284* Form x := inv( A**T )*x or x := inv( A**H )*x.
285*
286 IF (lsame(uplo,'U')) THEN
287 IF (incx.EQ.1) THEN
288 DO 110 j = 1,n
289 temp = x(j)
290 IF (noconj) THEN
291 DO 90 i = 1,j - 1
292 temp = temp - a(i,j)*x(i)
293 90 CONTINUE
294 IF (nounit) temp = temp/a(j,j)
295 ELSE
296 DO 100 i = 1,j - 1
297 temp = temp - dconjg(a(i,j))*x(i)
298 100 CONTINUE
299 IF (nounit) temp = temp/dconjg(a(j,j))
300 END IF
301 x(j) = temp
302 110 CONTINUE
303 ELSE
304 jx = kx
305 DO 140 j = 1,n
306 ix = kx
307 temp = x(jx)
308 IF (noconj) THEN
309 DO 120 i = 1,j - 1
310 temp = temp - a(i,j)*x(ix)
311 ix = ix + incx
312 120 CONTINUE
313 IF (nounit) temp = temp/a(j,j)
314 ELSE
315 DO 130 i = 1,j - 1
316 temp = temp - dconjg(a(i,j))*x(ix)
317 ix = ix + incx
318 130 CONTINUE
319 IF (nounit) temp = temp/dconjg(a(j,j))
320 END IF
321 x(jx) = temp
322 jx = jx + incx
323 140 CONTINUE
324 END IF
325 ELSE
326 IF (incx.EQ.1) THEN
327 DO 170 j = n,1,-1
328 temp = x(j)
329 IF (noconj) THEN
330 DO 150 i = n,j + 1,-1
331 temp = temp - a(i,j)*x(i)
332 150 CONTINUE
333 IF (nounit) temp = temp/a(j,j)
334 ELSE
335 DO 160 i = n,j + 1,-1
336 temp = temp - dconjg(a(i,j))*x(i)
337 160 CONTINUE
338 IF (nounit) temp = temp/dconjg(a(j,j))
339 END IF
340 x(j) = temp
341 170 CONTINUE
342 ELSE
343 kx = kx + (n-1)*incx
344 jx = kx
345 DO 200 j = n,1,-1
346 ix = kx
347 temp = x(jx)
348 IF (noconj) THEN
349 DO 180 i = n,j + 1,-1
350 temp = temp - a(i,j)*x(ix)
351 ix = ix - incx
352 180 CONTINUE
353 IF (nounit) temp = temp/a(j,j)
354 ELSE
355 DO 190 i = n,j + 1,-1
356 temp = temp - dconjg(a(i,j))*x(ix)
357 ix = ix - incx
358 190 CONTINUE
359 IF (nounit) temp = temp/dconjg(a(j,j))
360 END IF
361 x(jx) = temp
362 jx = jx - incx
363 200 CONTINUE
364 END IF
365 END IF
366 END IF
367*
368 RETURN
369*
370* End of ZTRSV
371*