1ZUNMHR(1)                LAPACK routine (version 3.2)                ZUNMHR(1)
2
3
4

NAME

6       ZUNMHR  -  overwrites the general complex M-by-N matrix C with   SIDE =
7       'L' SIDE = 'R' TRANS = 'N'
8

SYNOPSIS

10       SUBROUTINE ZUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA,  TAU,  C,  LDC,
11                          WORK, LWORK, INFO )
12
13           CHARACTER      SIDE, TRANS
14
15           INTEGER        IHI, ILO, INFO, LDA, LDC, LWORK, M, N
16
17           COMPLEX*16     A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
18

PURPOSE

20       ZUNMHR overwrites the general complex M-by-N matrix C with TRANS = 'C':
21       Q**H * C       C * Q**H
22       where Q is a complex unitary matrix of order nq, with nq = m if SIDE  =
23       'L'  and  nq  = n if SIDE = 'R'. Q is defined as the product of IHI-ILO
24       elementary reflectors, as returned by ZGEHRD:
25       Q = H(ilo) H(ilo+1) . . . H(ihi-1).
26

ARGUMENTS

28       SIDE    (input) CHARACTER*1
29               = 'L': apply Q or Q**H from the Left;
30               = 'R': apply Q or Q**H from the Right.
31
32       TRANS   (input) CHARACTER*1
33               = 'N': apply Q  (No transpose)
34               = 'C': apply Q**H (Conjugate transpose)
35
36       M       (input) INTEGER
37               The number of rows of the matrix C. M >= 0.
38
39       N       (input) INTEGER
40               The number of columns of the matrix C. N >= 0.
41
42       ILO     (input) INTEGER
43               IHI     (input) INTEGER ILO and IHI must have the  same  values
44               as  in  the  previous  call  of  ZGEHRD. Q is equal to the unit
45               matrix except in the submatrix Q(ilo+1:ihi,ilo+1:ihi).  If SIDE
46               = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and ILO = 1 and IHI
47               = 0, if M = 0; if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N >
48               0, and ILO = 1 and IHI = 0, if N = 0.
49
50       A       (input) COMPLEX*16 array, dimension
51               (LDA,M)  if  SIDE = 'L' (LDA,N) if SIDE = 'R' The vectors which
52               define the elementary reflectors, as returned by ZGEHRD.
53
54       LDA     (input) INTEGER
55               The leading dimension of the array A.  LDA >= max(1,M) if  SIDE
56               = 'L'; LDA >= max(1,N) if SIDE = 'R'.
57
58       TAU     (input) COMPLEX*16 array, dimension
59               (M-1) if SIDE = 'L' (N-1) if SIDE = 'R' TAU(i) must contain the
60               scalar factor of the elementary reflector H(i), as returned  by
61               ZGEHRD.
62
63       C       (input/output) COMPLEX*16 array, dimension (LDC,N)
64               On  entry,  the  M-by-N matrix C.  On exit, C is overwritten by
65               Q*C or Q**H*C or C*Q**H or C*Q.
66
67       LDC     (input) INTEGER
68               The leading dimension of the array C. LDC >= max(1,M).
69
70       WORK    (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
71               On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
72
73       LWORK   (input) INTEGER
74               The dimension of the array WORK.   If  SIDE  =  'L',  LWORK  >=
75               max(1,N);  if  SIDE = 'R', LWORK >= max(1,M).  For optimum per‐
76               formance LWORK >= N*NB if SIDE = 'L', and LWORK >= M*NB if SIDE
77               =  'R', where NB is the optimal blocksize.  If LWORK = -1, then
78               a workspace query is assumed; the routine only  calculates  the
79               optimal size of the WORK array, returns this value as the first
80               entry of the WORK array, and no error message related to  LWORK
81               is issued by XERBLA.
82
83       INFO    (output) INTEGER
84               = 0:  successful exit
85               < 0:  if INFO = -i, the i-th argument had an illegal value
86
87
88
89 LAPACK routine (version 3.2)    November 2008                       ZUNMHR(1)
Impressum