1 #include "FLA_lapack2flame_return_defs.h"
2 #include "FLA_f2c.h" /* Table of constant values */
3 static int c__1 = 1;
4 static int c_n1 = -1;
5
dormqr_check(char * side,char * trans,int * m,int * n,int * k,double * a,int * lda,double * tau,double * c__,int * ldc,double * work,int * lwork,int * info)6 int dormqr_check(char *side, char *trans, int *m, int *n, int *k, double *a, int *lda, double *tau, double * c__, int *ldc, double *work, int *lwork, int *info)
7 {
8 /* System generated locals */
9 int a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
10 char ch__1[2];
11
12 /* Local variables */
13 int nb, nq, nw;
14 logical left;
15 logical notran;
16 int lwkopt;
17 logical lquery;
18 /* Parameter adjustments */
19 a_dim1 = *lda;
20 a_offset = 1 + a_dim1;
21 a -= a_offset;
22 --tau;
23 c_dim1 = *ldc;
24 c_offset = 1 + c_dim1;
25 c__ -= c_offset;
26 --work;
27 /* Function Body */
28 *info = 0;
29 left = lsame_(side, "L");
30 notran = lsame_(trans, "N");
31 lquery = *lwork == -1;
32 /* NQ is the order of Q and NW is the minimum dimension of WORK */
33 if (left)
34 {
35 nq = *m;
36 nw = *n;
37 }
38 else
39 {
40 nq = *n;
41 nw = *m;
42 }
43 if (! left && ! lsame_(side, "R"))
44 {
45 *info = -1;
46 }
47 else if (! notran && ! lsame_(trans, "T"))
48 {
49 *info = -2;
50 }
51 else if (*m < 0)
52 {
53 *info = -3;
54 }
55 else if (*n < 0)
56 {
57 *info = -4;
58 }
59 else if (*k < 0 || *k > nq)
60 {
61 *info = -5;
62 }
63 else if (*lda < max(1,nq))
64 {
65 *info = -7;
66 }
67 else if (*ldc < max(1,*m))
68 {
69 *info = -10;
70 }
71 else if (*lwork < max(1,nw) && ! lquery)
72 {
73 *info = -12;
74 }
75 if (*info == 0)
76 {
77 /* Determine the block size. NB may be at most NBMAX, where NBMAX */
78 /* is used to define the local array T. */
79 /* Computing MIN */
80 i__1 = 64;
81 i__2 = ilaenv_(&c__1, "DORMQR", ch__1, m, n, k, &c_n1); // , expr subst
82 nb = min(i__1,i__2);
83 lwkopt = max(1,nw) * nb;
84 work[1] = (double) lwkopt;
85 }
86 if (*info != 0)
87 {
88 i__1 = -(*info);
89 xerbla_("DORMQR", &i__1);
90 return LAPACK_FAILURE;
91 }
92 else if (lquery)
93 {
94 return LAPACK_QUERY_RETURN;
95 }
96 /* Quick return if possible */
97 if (*m == 0 || *n == 0 || *k == 0)
98 {
99 work[1] = 1.;
100 return LAPACK_QUICK_RETURN;
101 }
102
103 return LAPACK_SUCCESS;
104 }
105