Lots of trailing whitespaces in the files of Syd. Cleaning this. No big deal.
[platform/upstream/lapack.git] / SRC / cunghr.f
1 *> \brief \b CUNGHR
2 *
3 *  =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 *            http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download CUNGHR + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cunghr.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cunghr.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cunghr.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 *  Definition:
19 *  ===========
20 *
21 *       SUBROUTINE CUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
22 *
23 *       .. Scalar Arguments ..
24 *       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
25 *       ..
26 *       .. Array Arguments ..
27 *       COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
28 *       ..
29 *
30 *
31 *> \par Purpose:
32 *  =============
33 *>
34 *> \verbatim
35 *>
36 *> CUNGHR generates a complex unitary matrix Q which is defined as the
37 *> product of IHI-ILO elementary reflectors of order N, as returned by
38 *> CGEHRD:
39 *>
40 *> Q = H(ilo) H(ilo+1) . . . H(ihi-1).
41 *> \endverbatim
42 *
43 *  Arguments:
44 *  ==========
45 *
46 *> \param[in] N
47 *> \verbatim
48 *>          N is INTEGER
49 *>          The order of the matrix Q. N >= 0.
50 *> \endverbatim
51 *>
52 *> \param[in] ILO
53 *> \verbatim
54 *>          ILO is INTEGER
55 *> \endverbatim
56 *>
57 *> \param[in] IHI
58 *> \verbatim
59 *>          IHI is INTEGER
60 *>
61 *>          ILO and IHI must have the same values as in the previous call
62 *>          of CGEHRD. Q is equal to the unit matrix except in the
63 *>          submatrix Q(ilo+1:ihi,ilo+1:ihi).
64 *>          1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
65 *> \endverbatim
66 *>
67 *> \param[in,out] A
68 *> \verbatim
69 *>          A is COMPLEX array, dimension (LDA,N)
70 *>          On entry, the vectors which define the elementary reflectors,
71 *>          as returned by CGEHRD.
72 *>          On exit, the N-by-N unitary matrix Q.
73 *> \endverbatim
74 *>
75 *> \param[in] LDA
76 *> \verbatim
77 *>          LDA is INTEGER
78 *>          The leading dimension of the array A. LDA >= max(1,N).
79 *> \endverbatim
80 *>
81 *> \param[in] TAU
82 *> \verbatim
83 *>          TAU is COMPLEX array, dimension (N-1)
84 *>          TAU(i) must contain the scalar factor of the elementary
85 *>          reflector H(i), as returned by CGEHRD.
86 *> \endverbatim
87 *>
88 *> \param[out] WORK
89 *> \verbatim
90 *>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
91 *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
92 *> \endverbatim
93 *>
94 *> \param[in] LWORK
95 *> \verbatim
96 *>          LWORK is INTEGER
97 *>          The dimension of the array WORK. LWORK >= IHI-ILO.
98 *>          For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
99 *>          the optimal blocksize.
100 *>
101 *>          If LWORK = -1, then a workspace query is assumed; the routine
102 *>          only calculates the optimal size of the WORK array, returns
103 *>          this value as the first entry of the WORK array, and no error
104 *>          message related to LWORK is issued by XERBLA.
105 *> \endverbatim
106 *>
107 *> \param[out] INFO
108 *> \verbatim
109 *>          INFO is INTEGER
110 *>          = 0:  successful exit
111 *>          < 0:  if INFO = -i, the i-th argument had an illegal value
112 *> \endverbatim
113 *
114 *  Authors:
115 *  ========
116 *
117 *> \author Univ. of Tennessee
118 *> \author Univ. of California Berkeley
119 *> \author Univ. of Colorado Denver
120 *> \author NAG Ltd.
121 *
122 *> \date November 2011
123 *
124 *> \ingroup complexOTHERcomputational
125 *
126 *  =====================================================================
127       SUBROUTINE CUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
128 *
129 *  -- LAPACK computational routine (version 3.4.0) --
130 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
131 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
132 *     November 2011
133 *
134 *     .. Scalar Arguments ..
135       INTEGER            IHI, ILO, INFO, LDA, LWORK, N
136 *     ..
137 *     .. Array Arguments ..
138       COMPLEX            A( LDA, * ), TAU( * ), WORK( * )
139 *     ..
140 *
141 *  =====================================================================
142 *
143 *     .. Parameters ..
144       COMPLEX            ZERO, ONE
145       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
146      $                   ONE = ( 1.0E+0, 0.0E+0 ) )
147 *     ..
148 *     .. Local Scalars ..
149       LOGICAL            LQUERY
150       INTEGER            I, IINFO, J, LWKOPT, NB, NH
151 *     ..
152 *     .. External Subroutines ..
153       EXTERNAL           CUNGQR, XERBLA
154 *     ..
155 *     .. External Functions ..
156       INTEGER            ILAENV
157       EXTERNAL           ILAENV
158 *     ..
159 *     .. Intrinsic Functions ..
160       INTRINSIC          MAX, MIN
161 *     ..
162 *     .. Executable Statements ..
163 *
164 *     Test the input arguments
165 *
166       INFO = 0
167       NH = IHI - ILO
168       LQUERY = ( LWORK.EQ.-1 )
169       IF( N.LT.0 ) THEN
170          INFO = -1
171       ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
172          INFO = -2
173       ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
174          INFO = -3
175       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
176          INFO = -5
177       ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
178          INFO = -8
179       END IF
180 *
181       IF( INFO.EQ.0 ) THEN
182          NB = ILAENV( 1, 'CUNGQR', ' ', NH, NH, NH, -1 )
183          LWKOPT = MAX( 1, NH )*NB
184          WORK( 1 ) = LWKOPT
185       END IF
186 *
187       IF( INFO.NE.0 ) THEN
188          CALL XERBLA( 'CUNGHR', -INFO )
189          RETURN
190       ELSE IF( LQUERY ) THEN
191          RETURN
192       END IF
193 *
194 *     Quick return if possible
195 *
196       IF( N.EQ.0 ) THEN
197          WORK( 1 ) = 1
198          RETURN
199       END IF
200 *
201 *     Shift the vectors which define the elementary reflectors one
202 *     column to the right, and set the first ilo and the last n-ihi
203 *     rows and columns to those of the unit matrix
204 *
205       DO 40 J = IHI, ILO + 1, -1
206          DO 10 I = 1, J - 1
207             A( I, J ) = ZERO
208    10    CONTINUE
209          DO 20 I = J + 1, IHI
210             A( I, J ) = A( I, J-1 )
211    20    CONTINUE
212          DO 30 I = IHI + 1, N
213             A( I, J ) = ZERO
214    30    CONTINUE
215    40 CONTINUE
216       DO 60 J = 1, ILO
217          DO 50 I = 1, N
218             A( I, J ) = ZERO
219    50    CONTINUE
220          A( J, J ) = ONE
221    60 CONTINUE
222       DO 80 J = IHI + 1, N
223          DO 70 I = 1, N
224             A( I, J ) = ZERO
225    70    CONTINUE
226          A( J, J ) = ONE
227    80 CONTINUE
228 *
229       IF( NH.GT.0 ) THEN
230 *
231 *        Generate Q(ilo+1:ihi,ilo+1:ihi)
232 *
233          CALL CUNGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
234      $                WORK, LWORK, IINFO )
235       END IF
236       WORK( 1 ) = LWKOPT
237       RETURN
238 *
239 *     End of CUNGHR
240 *
241       END