libflame  revision_anchor
Functions
dorml2.c File Reference

(r)

Functions

int dorml2_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

◆ dorml2_fla()

int dorml2_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 dormlq_fla().

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