1 #include "FLA_lapack2flame_return_defs.h"
2 #include "FLA_f2c.h"
3 static int c__1 = 1;
4 static int c_n1 = -1;
5
zunmbr_check(char * vect,char * side,char * trans,int * m,int * n,int * k,dcomplex * a,int * lda,dcomplex * tau,dcomplex * c__,int * ldc,dcomplex * work,int * lwork,int * info)6 int zunmbr_check(char *vect, char *side, char *trans, int *m, int *n, int *k, dcomplex *a, int *lda, dcomplex *tau, dcomplex *c__, int *ldc, dcomplex *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, applyq;
16 int lwkopt;
17 logical lquery;
18
19 /* Parameter adjustments */
20 a_dim1 = *lda;
21 a_offset = 1 + a_dim1;
22 a -= a_offset;
23 --tau;
24 c_dim1 = *ldc;
25 c_offset = 1 + c_dim1;
26 c__ -= c_offset;
27 --work;
28 /* Function Body */
29 *info = 0;
30 applyq = lsame_(vect, "Q");
31 left = lsame_(side, "L");
32 notran = lsame_(trans, "N");
33 lquery = *lwork == -1;
34 /* NQ is the order of Q or P and NW is the minimum dimension of WORK */
35 if (left)
36 {
37 nq = *m;
38 nw = *n;
39 }
40 else
41 {
42 nq = *n;
43 nw = *m;
44 }
45 if (*m == 0 || *n == 0)
46 {
47 nw = 0;
48 }
49 if (! applyq && ! lsame_(vect, "P"))
50 {
51 *info = -1;
52 }
53 else if (! left && ! lsame_(side, "R"))
54 {
55 *info = -2;
56 }
57 else if (! notran && ! lsame_(trans, "C"))
58 {
59 *info = -3;
60 }
61 else if (*m < 0)
62 {
63 *info = -4;
64 }
65 else if (*n < 0)
66 {
67 *info = -5;
68 }
69 else if (*k < 0)
70 {
71 *info = -6;
72 }
73 else /* if(complicated condition) */
74 {
75 /* Computing MAX */
76 i__1 = 1;
77 i__2 = min(nq,*k); // , expr subst
78 if (applyq && *lda < max(1,nq) || ! applyq && *lda < max(i__1,i__2))
79 {
80 *info = -8;
81 }
82 else if (*ldc < max(1,*m))
83 {
84 *info = -11;
85 }
86 else if (*lwork < max(1,nw) && ! lquery)
87 {
88 *info = -13;
89 }
90 }
91 if (*info == 0)
92 {
93 if (nw > 0)
94 {
95 if (applyq)
96 {
97 if (left)
98 {
99 i__1 = *m - 1;
100 i__2 = *m - 1;
101 nb = ilaenv_(&c__1, "ZUNMQR", ch__1, &i__1, n, &i__2, & c_n1);
102 }
103 else
104 {
105 i__1 = *n - 1;
106 i__2 = *n - 1;
107 nb = ilaenv_(&c__1, "ZUNMQR", ch__1, m, &i__1, &i__2, & c_n1);
108 }
109 }
110 else
111 {
112 if (left)
113 {
114 i__1 = *m - 1;
115 i__2 = *m - 1;
116 nb = ilaenv_(&c__1, "ZUNMLQ", ch__1, &i__1, n, &i__2, & c_n1);
117 }
118 else
119 {
120 i__1 = *n - 1;
121 i__2 = *n - 1;
122 nb = ilaenv_(&c__1, "ZUNMLQ", ch__1, m, &i__1, &i__2, & c_n1);
123 }
124 }
125 /* Computing MAX */
126 i__1 = 1;
127 i__2 = nw * nb; // , expr subst
128 lwkopt = max(i__1,i__2);
129 }
130 else
131 {
132 lwkopt = 1;
133 }
134 work[1].real = (double) lwkopt;
135 work[1].imag = 0.; // , expr subst
136 }
137 if (*info != 0)
138 {
139 i__1 = -(*info);
140 xerbla_("ZUNMBR", &i__1);
141 return LAPACK_FAILURE;
142 }
143 else if (lquery)
144 {
145 return LAPACK_QUERY_RETURN;
146 }
147 /* Quick return if possible */
148 if (*m == 0 || *n == 0)
149 {
150 return LAPACK_QUICK_RETURN;
151 }
152 return LAPACK_SUCCESS;
153 }
154