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
sormtr_check(char * side,char * uplo,char * trans,int * m,int * n,float * a,int * lda,float * tau,float * c__,int * ldc,float * work,int * lwork,int * info)6 int sormtr_check(char *side, char *uplo, char *trans, int *m, int *n, float *a, int *lda, float *tau, float *c__, int *ldc, float *work, int *lwork, int *info)
7 {
8 /* System generated locals */
9 int a_dim1, a_offset, c_dim1, c_offset, i__2, i__3;
10 char ch__1[2];
11 /* Local variables */
12 int nb, nq, nw;
13 logical left;
14 logical upper;
15 int lwkopt;
16 logical lquery;
17
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 upper = lsame_(uplo, "U");
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 (! upper && ! lsame_(uplo, "L"))
48 {
49 *info = -2;
50 }
51 else if (! lsame_(trans, "N") && ! lsame_(trans, "T"))
52 {
53 *info = -3;
54 }
55 else if (*m < 0)
56 {
57 *info = -4;
58 }
59 else if (*n < 0)
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 if (upper)
78 {
79 if (left)
80 {
81 i__2 = *m - 1;
82 i__3 = *m - 1;
83 nb = ilaenv_(&c__1, "SORMQL", ch__1, &i__2, n, &i__3, &c_n1);
84 }
85 else
86 {
87 i__2 = *n - 1;
88 i__3 = *n - 1;
89 nb = ilaenv_(&c__1, "SORMQL", ch__1, m, &i__2, &i__3, &c_n1);
90 }
91 }
92 else
93 {
94 if (left)
95 {
96 i__2 = *m - 1;
97 i__3 = *m - 1;
98 nb = ilaenv_(&c__1, "SORMQR", ch__1, &i__2, n, &i__3, &c_n1);
99 }
100 else
101 {
102 i__2 = *n - 1;
103 i__3 = *n - 1;
104 nb = ilaenv_(&c__1, "SORMQR", ch__1, m, &i__2, &i__3, &c_n1);
105 }
106 }
107 lwkopt = max(1,nw) * nb;
108 work[1] = (float) lwkopt;
109 }
110 if (*info != 0)
111 {
112 i__2 = -(*info);
113 xerbla_("SORMTR", &i__2);
114 return LAPACK_FAILURE;
115 }
116 else if (lquery)
117 {
118 return LAPACK_QUERY_RETURN;
119 }
120 /* Quick return if possible */
121 if (*m == 0 || *n == 0 || nq == 1)
122 {
123 work[1] = 1.f;
124 return LAPACK_QUICK_RETURN;
125 }
126 return LAPACK_SUCCESS;
127 }
128