libflame revision_anchor
Functions
zungl2.c File Reference

(r)

Functions

int zungl2_fla (integer *m, integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *work, integer *info)
 

Function Documentation

◆ zungl2_fla()

int zungl2_fla ( integer m,
integer n,
integer k,
doublecomplex a,
integer lda,
doublecomplex tau,
doublecomplex work,
integer info 
)
103{
104 /* System generated locals */
107 /* Builtin functions */
109 /* Local variables */
110 integer i__, j, l;
111 extern /* Subroutine */
113 /* -- LAPACK computational routine (version 3.4.2) -- */
114 /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
115 /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
116 /* September 2012 */
117 /* .. Scalar Arguments .. */
118 /* .. */
119 /* .. Array Arguments .. */
120 /* .. */
121 /* ===================================================================== */
122 /* .. Parameters .. */
123 /* .. */
124 /* .. Local Scalars .. */
125 /* .. */
126 /* .. External Subroutines .. */
127 /* .. */
128 /* .. Intrinsic Functions .. */
129 /* .. */
130 /* .. Executable Statements .. */
131 /* Test the input arguments */
132 /* Parameter adjustments */
133 a_dim1 = *lda;
134 a_offset = 1 + a_dim1;
135 a -= a_offset;
136 --tau;
137 --work;
138 /* Function Body */
139 *info = 0;
140 if (*m < 0)
141 {
142 *info = -1;
143 }
144 else if (*n < *m)
145 {
146 *info = -2;
147 }
148 else if (*k < 0 || *k > *m)
149 {
150 *info = -3;
151 }
152 else if (*lda < max(1,*m))
153 {
154 *info = -5;
155 }
156 if (*info != 0)
157 {
158 i__1 = -(*info);
159 xerbla_("ZUNGL2", &i__1);
160 return 0;
161 }
162 /* Quick return if possible */
163 if (*m <= 0)
164 {
165 return 0;
166 }
167 if (*k < *m)
168 {
169 /* Initialise rows k+1:m to rows of the unit matrix */
170 i__1 = *n;
171 for (j = 1;
172 j <= i__1;
173 ++j)
174 {
175 i__2 = *m;
176 for (l = *k + 1;
177 l <= i__2;
178 ++l)
179 {
180 i__3 = l + j * a_dim1;
181 a[i__3].r = 0.;
182 a[i__3].i = 0.; // , expr subst
183 /* L10: */
184 }
185 if (j > *k && j <= *m)
186 {
187 i__2 = j + j * a_dim1;
188 a[i__2].r = 1.;
189 a[i__2].i = 0.; // , expr subst
190 }
191 /* L20: */
192 }
193 }
194 for (i__ = *k;
195 i__ >= 1;
196 --i__)
197 {
198 /* Apply H(i)**H to A(i:m,i:n) from the right */
199 if (i__ < *n)
200 {
201 i__1 = *n - i__;
202 zlacgv_(&i__1, &a[i__ + (i__ + 1) * a_dim1], lda);
203 if (i__ < *m)
204 {
205 i__1 = i__ + i__ * a_dim1;
206 a[i__1].r = 1.;
207 a[i__1].i = 0.; // , expr subst
208 i__1 = *m - i__;
209 i__2 = *n - i__ + 1;
210 d_cnjg(&z__1, &tau[i__]);
211 zlarf_("Right", &i__1, &i__2, &a[i__ + i__ * a_dim1], lda, & z__1, &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
212 }
213 i__1 = *n - i__;
214 i__2 = i__;
215 z__1.r = -tau[i__2].r;
216 z__1.i = -tau[i__2].i; // , expr subst
217 zscal_(&i__1, &z__1, &a[i__ + (i__ + 1) * a_dim1], lda);
218 i__1 = *n - i__;
219 zlacgv_(&i__1, &a[i__ + (i__ + 1) * a_dim1], lda);
220 }
221 i__1 = i__ + i__ * a_dim1;
222 d_cnjg(&z__2, &tau[i__]);
223 z__1.r = 1. - z__2.r;
224 z__1.i = 0. - z__2.i; // , expr subst
225 a[i__1].r = z__1.r;
226 a[i__1].i = z__1.i; // , expr subst
227 /* Set A(i,1:i-1) to zero */
228 i__1 = i__ - 1;
229 for (l = 1;
230 l <= i__1;
231 ++l)
232 {
233 i__2 = i__ + l * a_dim1;
234 a[i__2].r = 0.;
235 a[i__2].i = 0.; // , expr subst
236 /* L30: */
237 }
238 /* L40: */
239 }
240 return 0;
241 /* End of ZUNGL2 */
242}
int integer
Definition FLA_f2c.h:25
int i
Definition bl1_axmyv2.c:145
Definition FLA_f2c.h:33

References i.

Referenced by zunglq_fla().