ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Ctzsymm.c
Go to the documentation of this file.
1 /* ---------------------------------------------------------------------
2 *
3 * -- PBLAS auxiliary routine (version 2.0) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * April 1, 1998
7 *
8 * ---------------------------------------------------------------------
9 */
10 /*
11 * Include files
12 */
13 #include "../pblas.h"
14 #include "../PBpblas.h"
15 #include "../PBtools.h"
16 #include "../PBblacs.h"
17 #include "../PBblas.h"
18 
19 #ifdef __STDC__
20 void PB_Ctzsymm( PBTYP_T * TYPE, char * SIDE, char * UPLO, int M, int N,
21  int K, int IOFFD, char * ALPHA, char * A, int LDA,
22  char * BC, int LDBC, char * BR, int LDBR, char * CC,
23  int LDCC, char * CR, int LDCR )
24 #else
25 void PB_Ctzsymm( TYPE, SIDE, UPLO, M, N, K, IOFFD, ALPHA, A, LDA, BC,
26  LDBC, BR, LDBR, CC, LDCC, CR, LDCR )
27 /*
28 * .. Scalar Arguments ..
29 */
30  char * SIDE, * UPLO;
31  int IOFFD, K, LDA, LDBC, LDBR, LDCC, LDCR, M, N;
32  char * ALPHA;
33 /*
34 * .. Array Arguments ..
35 */
36  PBTYP_T * TYPE;
37  char * A, * BC, * BR, * CC, * CR;
38 #endif
39 {
40 /*
41 * Purpose
42 * =======
43 *
44 * PB_Ctzsymm performs the matrix-matrix operation
45 *
46 * C := alpha * A * B + C,
47 *
48 * or
49 *
50 * C := alpha * B * A + C,
51 *
52 * where alpha is a scalar, B and C are m by k and k by n matrices and A
53 * is an m by n trapezoidal symmetric or Hermitian matrix.
54 *
55 * Arguments
56 * =========
57 *
58 * TYPE (local input) pointer to a PBTYP_T structure
59 * On entry, TYPE is a pointer to a structure of type PBTYP_T,
60 * that contains type information (See pblas.h).
61 *
62 * SIDE (input) pointer to CHAR
63 * On entry, SIDE specifies whether op( A ) multiplies B from
64 * the left or right as follows:
65 *
66 * SIDE = 'L' or 'l' C := alpha * A * B + C,
67 *
68 * SIDE = 'R' or 'r' C := alpha * B * A + C.
69 *
70 * UPLO (input) pointer to CHAR
71 * On entry, UPLO specifies which part of the matrix A is to be
72 * referenced as follows:
73 *
74 * UPLO = 'L' or 'l' the lower trapezoid of A is referenced,
75 *
76 * UPLO = 'U' or 'u' the upper trapezoid of A is referenced,
77 *
78 * otherwise all of the matrix A is referenced.
79 *
80 * M (input) INTEGER
81 * On entry, M specifies the number of rows of the matrix A. M
82 * must be at least zero.
83 *
84 * N (input) INTEGER
85 * On entry, N specifies the number of columns of the matrix A.
86 * N must be at least zero.
87 *
88 * K (input) INTEGER
89 * On entry, K specifies the number of rows of the matrices BR
90 * and CR and the number of columns of the matrices BC and CC. K
91 * must be at least zero.
92 *
93 * IOFFD (input) INTEGER
94 * On entry, IOFFD specifies the position of the offdiagonal de-
95 * limiting the upper and lower trapezoidal part of A as follows
96 * (see the notes below):
97 *
98 * IOFFD = 0 specifies the main diagonal A( i, i ),
99 * with i = 1 ... MIN( M, N ),
100 * IOFFD > 0 specifies the subdiagonal A( i+IOFFD, i ),
101 * with i = 1 ... MIN( M-IOFFD, N ),
102 * IOFFD < 0 specifies the superdiagonal A( i, i-IOFFD ),
103 * with i = 1 ... MIN( M, N+IOFFD ).
104 *
105 * ALPHA (input) pointer to CHAR
106 * On entry, ALPHA specifies the scalar alpha.
107 *
108 * A (input) pointer to CHAR
109 * On entry, A is an array of dimension (LDA,N) containing the m
110 * by n matrix A. Only the trapezoidal part of A determined by
111 * UPLO and IOFFD is referenced.
112 *
113 * LDA (input) INTEGER
114 * On entry, LDA specifies the leading dimension of the array A.
115 * LDA must be at least max( 1, M ).
116 *
117 * BC (input) pointer to CHAR
118 * On entry, BC is an array of dimension (LDBC,K) containing the
119 * m by k matrix BC.
120 *
121 * LDBC (input) INTEGER
122 * On entry, LDBC specifies the leading dimension of the array
123 * BC. LDBC must be at least max( 1, M ).
124 *
125 * BR (input) pointer to CHAR
126 * On entry, BR is an array of dimension (LDBR,N) containing the
127 * k by n matrix BR.
128 *
129 * LDBR (input) INTEGER
130 * On entry, LDBR specifies the leading dimension of the array
131 * BR. LDBR must be at least K.
132 *
133 * CC (input/output) pointer to CHAR
134 * On entry, CC is an array of dimension (LDCC,K) containing the
135 * m by k matrix CC. On exit, CC is overwritten by the partially
136 * updated matric CC.
137 *
138 * LDCC (input) INTEGER
139 * On entry, LDCC specifies the leading dimension of the array
140 * CC. LDCC must be at least max( 1, M ).
141 *
142 * CR (input/output) pointer to CHAR
143 * On entry, CR is an array of dimension (LDCR,N) containing the
144 * k by n matrix CR. On exit, CR is overwritten by the partially
145 * updated matrix CR.
146 *
147 * LDCR (input) INTEGER
148 * On entry, LDCR specifies the leading dimension of the array
149 * CR. LDCR must be at least K.
150 *
151 * Notes
152 * =====
153 * N N
154 * ---------------------------- -----------
155 * | d | | |
156 * M | d Upper | | Upper |
157 * | Lower d | |d |
158 * | d | M | d |
159 * ---------------------------- | d |
160 * | d |
161 * IOFFD < 0 | Lower d |
162 * | d|
163 * N | |
164 * ----------- -----------
165 * | d Upper|
166 * | d | IOFFD > 0
167 * M | d |
168 * | d| N
169 * | Lower | ----------------------------
170 * | | | Upper |
171 * | | |d |
172 * | | | d |
173 * | | | d |
174 * | | |Lower d |
175 * ----------- ----------------------------
176 *
177 * -- Written on April 1, 1998 by
178 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
179 *
180 * ---------------------------------------------------------------------
181 */
182 /*
183 * .. Local Scalars ..
184 */
185  char * one;
186  int i1, j1, m1, mn, n1, size;
187  GEMM_T gemm;
188 /* ..
189 * .. Executable Statements ..
190 *
191 */
192  if( ( M <= 0 ) || ( N <= 0 ) ) return;
193 
194  if( Mupcase( SIDE[0] ) == CLEFT )
195  {
196  if( Mupcase( UPLO[0] ) == CLOWER )
197  {
198  size = TYPE->size; one = TYPE->one; gemm = TYPE->Fgemm;
199  mn = MAX( 0, -IOFFD );
200 
201  if( ( n1 = MIN( mn, N ) ) > 0 )
202  {
203  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &M, &K, &n1, ALPHA, A,
204  &LDA, BR, &LDBR, one, CC, &LDCC );
205  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &M, ALPHA, BC,
206  &LDBC, A, &LDA, one, CR, &LDCR );
207  }
208  n1 = M - IOFFD;
209  if( ( n1 = MIN( n1, N ) - mn ) > 0 )
210  {
211  i1 = ( j1 = mn ) + IOFFD;
212  TYPE->Fsymm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), &n1, &K, ALPHA,
213  Mptr( A, i1, j1, LDA, size ), &LDA, Mptr( BC, i1, 0,
214  LDBC, size ), &LDBC, one, Mptr( CC, i1, 0, LDCC,
215  size ), &LDCC );
216  if( ( m1 = M - mn - n1 - IOFFD ) > 0 )
217  {
218  i1 += n1;
219  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &m1, &K, &n1, ALPHA,
220  Mptr( A, i1, j1, LDA, size ), &LDA, Mptr( BR, 0, j1, LDBR,
221  size ), &LDBR, one, Mptr( CC, i1, 0, LDCC, size ), &LDCC );
222  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &m1, ALPHA,
223  Mptr( BC, i1, 0, LDBC, size ), &LDBC, Mptr( A, i1, j1, LDA,
224  size ), &LDA, one, Mptr( CR, 0, j1, LDCR, size ), &LDCR );
225  }
226  }
227  }
228  else if( Mupcase( UPLO[0] ) == CUPPER )
229  {
230  size = TYPE->size; one = TYPE->one; gemm = TYPE->Fgemm;
231  mn = MIN( M - IOFFD, N );
232 
233  if( ( n1 = mn - MAX( 0, -IOFFD ) ) > 0 )
234  {
235  j1 = mn - n1;
236  if( ( m1 = MAX( 0, IOFFD ) ) > 0 )
237  {
238  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &m1, &K, &n1,
239  ALPHA, A, &LDA, BR, &LDBR, one, CC, &LDCC );
240  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &m1,
241  ALPHA, BC, &LDBC, A, &LDA, one, CR, &LDCR );
242  }
243  TYPE->Fsymm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), &n1, &K, ALPHA,
244  Mptr( A, m1, j1, LDA, size ), &LDA,
245  Mptr( BC, m1, 0, LDBC, size ), &LDBC, one,
246  Mptr( CC, m1, 0, LDCC, size ), &LDCC );
247  }
248  if( ( n1 = N - MAX( 0, mn ) ) > 0 )
249  {
250  j1 = N - n1;
251  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &M, &K, &n1,
252  ALPHA, Mptr( A, 0, j1, LDA, size ), &LDA, Mptr( BR, 0,
253  j1, LDBR, size ), &LDBR, one, CC, &LDCC );
254  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &M,
255  ALPHA, BC, &LDBC, Mptr( A, 0, j1, LDA, size ), &LDA,
256  one, Mptr( CR, 0, j1, LDCR, size ), &LDCR );
257  }
258  }
259  else
260  {
261  one = TYPE->one; gemm = TYPE->Fgemm;
262  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &M, &K, &N, ALPHA, A, &LDA,
263  BR, &LDBR, one, CC, &LDCC );
264  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &N, &M, ALPHA, BC,
265  &LDBC, A, &LDA, one, CR, &LDCR );
266  }
267  }
268  else
269  {
270  if( Mupcase( UPLO[0] ) == CLOWER )
271  {
272  size = TYPE->size; one = TYPE->one; gemm = TYPE->Fgemm;
273  mn = MAX( 0, -IOFFD );
274  if( ( n1 = MIN( mn, N ) ) > 0 )
275  {
276  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &M, &K, &n1, ALPHA, A,
277  &LDA, BR, &LDBR, one, CC, &LDCC );
278  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &M, ALPHA, BC,
279  &LDBC, A, &LDA, one, CR, &LDCR );
280  }
281  n1 = M - IOFFD;
282  if( ( n1 = MIN( n1, N ) - mn ) > 0 )
283  {
284  i1 = ( j1 = mn ) + IOFFD;
285  TYPE->Fsymm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), &K, &n1, ALPHA,
286  Mptr( A, i1, j1, LDA, size ), &LDA,
287  Mptr( BR, 0, j1, LDBR, size ), &LDBR, one,
288  Mptr( CR, 0, j1, LDCR, size ), &LDCR );
289  if( ( m1 = M - mn - n1 - IOFFD ) > 0 )
290  {
291  i1 += n1;
292  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &m1, &K, &n1, ALPHA,
293  Mptr( A, i1, j1, LDA, size ), &LDA, Mptr( BR, 0, j1, LDBR,
294  size ), &LDBR, one, Mptr( CC, i1, 0, LDCC, size ), &LDCC );
295  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &m1, ALPHA,
296  Mptr( BC, i1, 0, LDBC, size ), &LDBC, Mptr( A, i1, j1, LDA,
297  size ), &LDA, one, Mptr( CR, 0, j1, LDCR, size ), &LDCR );
298  }
299  }
300  }
301  else if( Mupcase( UPLO[0] ) == CUPPER )
302  {
303  size = TYPE->size; one = TYPE->one; gemm = TYPE->Fgemm;
304  mn = MIN( M - IOFFD, N );
305  if( ( n1 = mn - MAX( 0, -IOFFD ) ) > 0 )
306  {
307  j1 = mn - n1;
308  if( ( m1 = MAX( 0, IOFFD ) ) > 0 )
309  {
310  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &m1, &K, &n1, ALPHA,
311  A, &LDA, BR, &LDBR, one, CC, &LDCC );
312  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &m1, ALPHA,
313  BC, &LDBC, A, &LDA, one, CR, &LDCR );
314  }
315  TYPE->Fsymm( C2F_CHAR( SIDE ), C2F_CHAR( UPLO ), &K, &n1, ALPHA,
316  Mptr( A, m1, j1, LDA, size ), &LDA, Mptr( BR, 0, j1,
317  LDBR, size ), &LDBR, one, Mptr( CR, 0, j1, LDCR,
318  size ), &LDCR );
319  }
320  if( ( n1 = N - MAX( 0, mn ) ) > 0 )
321  {
322  j1 = N - n1;
323  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &M, &K, &n1, ALPHA,
324  Mptr( A, 0, j1, LDA, size ), &LDA, Mptr( BR, 0, j1, LDBR,
325  size ), &LDBR, one, CC, &LDCC );
326  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &n1, &M, ALPHA, BC,
327  &LDBC, Mptr( A, 0, j1, LDA, size ), &LDA, one, Mptr( CR, 0,
328  j1, LDCR, size ), &LDCR );
329  }
330  }
331  else
332  {
333  one = TYPE->one; gemm = TYPE->Fgemm;
334  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( TRAN ), &M, &K, &N, ALPHA, A, &LDA,
335  BR, &LDBR, one, CC, &LDCC );
336  gemm( C2F_CHAR( TRAN ), C2F_CHAR( NOTRAN ), &K, &N, &M, ALPHA, BC,
337  &LDBC, A, &LDA, one, CR, &LDCR );
338  }
339  }
340 /*
341 * End of PB_Ctzsymm
342 */
343 }
TYPE
#define TYPE
Definition: clamov.c:7
PB_Ctzsymm
void PB_Ctzsymm(PBTYP_T *TYPE, char *SIDE, char *UPLO, int M, int N, int K, int IOFFD, char *ALPHA, char *A, int LDA, char *BC, int LDBC, char *BR, int LDBR, char *CC, int LDCC, char *CR, int LDCR)
Definition: PB_Ctzsymm.c:25
GEMM_T
F_VOID_FCT(* GEMM_T)()
Definition: pblas.h:313
TRAN
#define TRAN
Definition: PBblas.h:46
NOTRAN
#define NOTRAN
Definition: PBblas.h:44
CLOWER
#define CLOWER
Definition: PBblas.h:25
MIN
#define MIN(a_, b_)
Definition: PBtools.h:76
C2F_CHAR
#define C2F_CHAR(a)
Definition: pblas.h:121
MAX
#define MAX(a_, b_)
Definition: PBtools.h:77
PBTYP_T
Definition: pblas.h:325
Mupcase
#define Mupcase(C)
Definition: PBtools.h:83
CUPPER
#define CUPPER
Definition: PBblas.h:26
Mptr
#define Mptr(a_, i_, j_, lda_, siz_)
Definition: PBtools.h:132
CLEFT
#define CLEFT
Definition: PBblas.h:29