MAGMA  magma-1.4.0 Matrix Algebra on GPU and Multicore Architectures
dormtr.cpp
Go to the documentation of this file.
1 /*
2  -- MAGMA (version 1.4.0) --
3  Univ. of Tennessee, Knoxville
4  Univ. of California, Berkeley
6  August 2013
7
8  @author Stan Tomov
9  @author Raffaele Solca
10
11  @generated d Tue Aug 13 16:44:36 2013
12
13 */
14 #include "common_magma.h"
15
16 extern "C" magma_int_t
17 magma_dormtr(char side, char uplo, char trans,
19  double *a, magma_int_t lda,
20  double *tau,
21  double *c, magma_int_t ldc,
22  double *work, magma_int_t lwork,
23  magma_int_t *info)
24 {
25 /* -- MAGMA (version 1.4.0) --
26  Univ. of Tennessee, Knoxville
27  Univ. of California, Berkeley
29  August 2013
30
31  Purpose
32  =======
33  DORMTR 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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) DOUBLE_PRECISION 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  double c_one = MAGMA_D_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  magma_int_t i1, i2, nb, mi, ni, nq, nw;
120  int left, upper, lquery;
121  magma_int_t iinfo;
122  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  nb = 32;
157  lwkopt = max(1,nw) * nb;
158  if (*info == 0) {
159  MAGMA_D_SET2REAL( work[0], lwkopt );
160  }
161
162  if (*info != 0) {
163  magma_xerbla( __func__, -(*info) );
164  return *info;
165  }
166  else if (lquery) {
167  return *info;
168  }
169
170  /* Quick return if possible */
171  if (m == 0 || n == 0 || nq == 1) {
172  work[0] = c_one;
173  return *info;
174  }
175
176  if (left) {
177  mi = m - 1;
178  ni = n;
179  } else {
180  mi = m;
181  ni = n - 1;
182  }
183
184  if (upper)
185  {
186  /* Q was determined by a call to SSYTRD with UPLO = 'U' */
187  i__2 = nq - 1;
188  //lapackf77_dormql(side_, trans_, &mi, &ni, &i__2, &a[lda], &lda,
189  // tau, c, &ldc, work, &lwork, &iinfo);
190  magma_dormql(side, trans, mi, ni, i__2, &a[lda], lda, tau,
191  c, ldc, work, lwork, &iinfo);
192  }
193  else
194  {
195  /* Q was determined by a call to SSYTRD with UPLO = 'L' */
196  if (left) {
197  i1 = 1;
198  i2 = 0;
199  } else {
200  i1 = 0;
201  i2 = 1;
202  }
203  i__2 = nq - 1;
204  magma_dormqr(side, trans, mi, ni, i__2, &a[1], lda, tau,
205  &c[i1 + i2 * ldc], ldc, work, lwork, &iinfo);
206  }
207
208  MAGMA_D_SET2REAL( work[0], lwkopt );
209
210  return *info;
211 } /* magma_dormtr */
212
#define MAGMA_D_ONE
Definition: magma.h:176
#define __func__
Definition: common_magma.h:65
magma_int_t magma_dormqr(char side, char trans, magma_int_t m, magma_int_t n, magma_int_t k, double *a, magma_int_t lda, double *tau, double *c, magma_int_t ldc, double *work, magma_int_t lwork, magma_int_t *info)
Definition: dormqr.cpp:16
int magma_int_t
Definition: magmablas.h:12
magma_int_t magma_dormql(char side, char trans, magma_int_t m, magma_int_t n, magma_int_t k, double *a, magma_int_t lda, double *tau, double *c, magma_int_t ldc, double *work, magma_int_t lwork, magma_int_t *info)
Definition: dormql.cpp:16
void magma_xerbla(const char *srname, magma_int_t info)
Definition: xerbla.cpp:8
#define lapackf77_lsame
Definition: magma_lapack.h:23
#define MAGMA_D_SET2REAL(v, t)
Definition: magma.h:159
magma_int_t magma_dormtr(char side, char uplo, char trans, magma_int_t m, magma_int_t n, double *a, magma_int_t lda, double *tau, double *c, magma_int_t ldc, double *work, magma_int_t lwork, magma_int_t *info)
Definition: dormtr.cpp:17
#define max(a, b)
Definition: common_magma.h:82