MAGMA  1.2.0
MatrixAlgebraonGPUandMulticoreArchitectures
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Groups
sormtr.cpp
Go to the documentation of this file.
1 /*
2  -- MAGMA (version 1.2.0) --
3  Univ. of Tennessee, Knoxville
4  Univ. of California, Berkeley
5  Univ. of Colorado, Denver
6  May 2012
7 
8  @author Stan Tomov
9  @author Raffaele Solca
10 
11  @generated s Thu May 10 22:26:58 2012
12 
13 */
14 #include "common_magma.h"
15 
16 extern "C" magma_int_t
17 magma_sormtr(char side, char uplo, char trans,
18  magma_int_t m, magma_int_t n,
19  float *a, magma_int_t lda,
20  float *tau,
21  float *c, magma_int_t ldc,
22  float *work, magma_int_t lwork,
23  magma_int_t *info)
24 {
25 /* -- MAGMA (version 1.2.0) --
26  Univ. of Tennessee, Knoxville
27  Univ. of California, Berkeley
28  Univ. of Colorado, Denver
29  May 2012
30 
31  Purpose
32  =======
33  SORMTR overwrites the general real M-by-N matrix C with
34 
35  SIDE = 'L' SIDE = 'R'
36  TRANS = 'N': Q * C C * Q
37  TRANS = 'T': Q**T * C C * Q**T
38 
39  where Q is a real orthogonal matrix of order nq, with nq = m if
40  SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
41  nq-1 elementary reflectors, as returned by SSYTRD:
42 
43  if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1);
44 
45  if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1).
46 
47  Arguments
48  =========
49  SIDE (input) CHARACTER*1
50  = 'L': apply Q or Q**T from the Left;
51  = 'R': apply Q or Q**T from the Right.
52 
53  UPLO (input) CHARACTER*1
54  = 'U': Upper triangle of A contains elementary reflectors
55  from SSYTRD;
56  = 'L': Lower triangle of A contains elementary reflectors
57  from SSYTRD.
58 
59  TRANS (input) CHARACTER*1
60  = 'N': No transpose, apply Q;
61  = 'T': Transpose, apply Q**T.
62 
63  M (input) INTEGER
64  The number of rows of the matrix C. M >= 0.
65 
66  N (input) INTEGER
67  The number of columns of the matrix C. N >= 0.
68 
69  A (input) REAL array, dimension
70  (LDA,M) if SIDE = 'L'
71  (LDA,N) if SIDE = 'R'
72  The vectors which define the elementary reflectors, as
73  returned by SSYTRD.
74 
75  LDA (input) INTEGER
76  The leading dimension of the array A.
77  LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
78 
79  TAU (input) REAL array, dimension
80  (M-1) if SIDE = 'L'
81  (N-1) if SIDE = 'R'
82  TAU(i) must contain the scalar factor of the elementary
83  reflector H(i), as returned by SSYTRD.
84 
85  C (input/output) REAL array, dimension (LDC,N)
86  On entry, the M-by-N matrix C.
87  On exit, C is overwritten by Q*C or Q**T * C or C * Q**T or C*Q.
88 
89  LDC (input) INTEGER
90  The leading dimension of the array C. LDC >= max(1,M).
91 
92  WORK (workspace/output) REAL array, dimension (MAX(1,LWORK))
93  On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
94 
95  LWORK (input) INTEGER
96  The dimension of the array WORK.
97  If SIDE = 'L', LWORK >= max(1,N);
98  if SIDE = 'R', LWORK >= max(1,M).
99  For optimum performance LWORK >= N*NB if SIDE = 'L', and
100  LWORK >= M*NB if SIDE = 'R', where NB is the optimal
101  blocksize.
102 
103  If LWORK = -1, then a workspace query is assumed; the routine
104  only calculates the optimal size of the WORK array, returns
105  this value as the first entry of the WORK array, and no error
106  message related to LWORK is issued.
107 
108  INFO (output) INTEGER
109  = 0: successful exit
110  < 0: if INFO = -i, the i-th argument had an illegal value
111  ===================================================================== */
112 
113  float c_one = MAGMA_S_ONE;
114 
115  char side_[2] = {side, 0};
116  char uplo_[2] = {uplo, 0};
117  char trans_[2] = {trans, 0};
118  magma_int_t i__2;
119  static magma_int_t i1, i2, nb, mi, ni, nq, nw;
120  long int left, upper, lquery;
121  static magma_int_t iinfo;
122  static magma_int_t lwkopt;
123 
124  *info = 0;
125  left = lapackf77_lsame(side_, "L");
126  upper = lapackf77_lsame(uplo_, "U");
127  lquery = lwork == -1;
128 
129  /* NQ is the order of Q and NW is the minimum dimension of WORK */
130  if (left) {
131  nq = m;
132  nw = n;
133  } else {
134  nq = n;
135  nw = m;
136  }
137  if (! left && ! lapackf77_lsame(side_, "R")) {
138  *info = -1;
139  } else if (! upper && ! lapackf77_lsame(uplo_, "L")) {
140  *info = -2;
141  } else if (! lapackf77_lsame(trans_, "N") &&
142  ! lapackf77_lsame(trans_, "C")) {
143  *info = -3;
144  } else if (m < 0) {
145  *info = -4;
146  } else if (n < 0) {
147  *info = -5;
148  } else if (lda < max(1,nq)) {
149  *info = -7;
150  } else if (ldc < max(1,m)) {
151  *info = -10;
152  } else if (lwork < max(1,nw) && ! lquery) {
153  *info = -12;
154  }
155 
156  if (*info == 0)
157  {
158  nb = 32;
159  lwkopt = max(1,nw) * nb;
160  MAGMA_S_SET2REAL( work[0], lwkopt );
161  }
162 
163  if (*info != 0) {
164  magma_xerbla( __func__, -(*info) );
165  return *info;
166  }
167  else if (lquery) {
168  return *info;
169  }
170 
171  /* Quick return if possible */
172  if (m == 0 || n == 0 || nq == 1) {
173  work[0] = c_one;
174  return *info;
175  }
176 
177  if (left) {
178  mi = m - 1;
179  ni = n;
180  } else {
181  mi = m;
182  ni = n - 1;
183  }
184 
185  if (upper)
186  {
187  /* Q was determined by a call to SSYTRD with UPLO = 'U' */
188  i__2 = nq - 1;
189  //lapackf77_sormql(side_, trans_, &mi, &ni, &i__2, &a[lda], &lda,
190  // tau, c, &ldc, work, &lwork, &iinfo);
191  magma_sormql(side, trans, mi, ni, i__2, &a[lda], lda, tau,
192  c, ldc, work, lwork, &iinfo);
193  }
194  else
195  {
196  /* Q was determined by a call to SSYTRD with UPLO = 'L' */
197  if (left) {
198  i1 = 1;
199  i2 = 0;
200  } else {
201  i1 = 0;
202  i2 = 1;
203  }
204  i__2 = nq - 1;
205  magma_sormqr(side, trans, mi, ni, i__2, &a[1], lda, tau,
206  &c[i1 + i2 * ldc], ldc, work, lwork, &iinfo);
207  }
208 
209  MAGMA_S_SET2REAL( work[0], lwkopt );
210 
211  return *info;
212 } /* magma_sormtr */
213