libflame  revision_anchor
Functions
dorm2r.c File Reference

(r)

Functions

int dorm2r_fla (char *side, char *trans, integer *m, integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work, integer *info)
 

Function Documentation

◆ dorm2r_fla()

int dorm2r_fla ( char *  side,
char *  trans,
integer m,
integer n,
integer k,
doublereal a,
integer lda,
doublereal tau,
doublereal c__,
integer ldc,
doublereal work,
integer info 
)

Referenced by dormqr_fla().

152 {
153  /* System generated locals */
154  integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
155  /* Local variables */
156  integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
157  doublereal aii;
158  logical left;
159  extern /* Subroutine */
160  int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, doublereal *);
161  extern logical lsame_(char *, char *);
162  extern /* Subroutine */
163  int xerbla_(char *, integer *);
164  logical notran;
165  /* -- LAPACK computational routine (version 3.4.2) -- */
166  /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
167  /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
168  /* September 2012 */
169  /* .. Scalar Arguments .. */
170  /* .. */
171  /* .. Array Arguments .. */
172  /* .. */
173  /* ===================================================================== */
174  /* .. Parameters .. */
175  /* .. */
176  /* .. Local Scalars .. */
177  /* .. */
178  /* .. External Functions .. */
179  /* .. */
180  /* .. External Subroutines .. */
181  /* .. */
182  /* .. Intrinsic Functions .. */
183  /* .. */
184  /* .. Executable Statements .. */
185  /* Test the input arguments */
186  /* Parameter adjustments */
187  a_dim1 = *lda;
188  a_offset = 1 + a_dim1;
189  a -= a_offset;
190  --tau;
191  c_dim1 = *ldc;
192  c_offset = 1 + c_dim1;
193  c__ -= c_offset;
194  --work;
195  /* Function Body */
196  *info = 0;
197  left = lsame_(side, "L");
198  notran = lsame_(trans, "N");
199  /* NQ is the order of Q */
200  if (left)
201  {
202  nq = *m;
203  }
204  else
205  {
206  nq = *n;
207  }
208  if (! left && ! lsame_(side, "R"))
209  {
210  *info = -1;
211  }
212  else if (! notran && ! lsame_(trans, "T"))
213  {
214  *info = -2;
215  }
216  else if (*m < 0)
217  {
218  *info = -3;
219  }
220  else if (*n < 0)
221  {
222  *info = -4;
223  }
224  else if (*k < 0 || *k > nq)
225  {
226  *info = -5;
227  }
228  else if (*lda < max(1,nq))
229  {
230  *info = -7;
231  }
232  else if (*ldc < max(1,*m))
233  {
234  *info = -10;
235  }
236  if (*info != 0)
237  {
238  i__1 = -(*info);
239  xerbla_("DORM2R", &i__1);
240  return 0;
241  }
242  /* Quick return if possible */
243  if (*m == 0 || *n == 0 || *k == 0)
244  {
245  return 0;
246  }
247  if (left && ! notran || ! left && notran)
248  {
249  i1 = 1;
250  i2 = *k;
251  i3 = 1;
252  }
253  else
254  {
255  i1 = *k;
256  i2 = 1;
257  i3 = -1;
258  }
259  if (left)
260  {
261  ni = *n;
262  jc = 1;
263  }
264  else
265  {
266  mi = *m;
267  ic = 1;
268  }
269  i__1 = i2;
270  i__2 = i3;
271  for (i__ = i1;
272  i__2 < 0 ? i__ >= i__1 : i__ <= i__1;
273  i__ += i__2)
274  {
275  if (left)
276  {
277  /* H(i) is applied to C(i:m,1:n) */
278  mi = *m - i__ + 1;
279  ic = i__;
280  }
281  else
282  {
283  /* H(i) is applied to C(1:m,i:n) */
284  ni = *n - i__ + 1;
285  jc = i__;
286  }
287  /* Apply H(i) */
288  aii = a[i__ + i__ * a_dim1];
289  a[i__ + i__ * a_dim1] = 1.;
290  dlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[ ic + jc * c_dim1], ldc, &work[1]);
291  a[i__ + i__ * a_dim1] = aii;
292  /* L10: */
293  }
294  return 0;
295  /* End of DORM2R */
296 }
double doublereal
Definition: FLA_f2c.h:31
int logical
Definition: FLA_f2c.h:36
int integer
Definition: FLA_f2c.h:25