ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Ctzher2k.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_Ctzher2k( PBTYP_T * TYPE, char * UPLO, int M, int N, int K,
21  int IOFFD, char * ALPHA, char * AC, int LDAC,
22  char * BC, int LDBC, char * AR, int LDAR, char * BR,
23  int LDBR, char * C, int LDC )
24 #else
25 void PB_Ctzher2k( TYPE, UPLO, M, N, K, IOFFD, ALPHA, AC, LDAC, BC, LDBC,
26  AR, LDAR, BR, LDBR, C, LDC )
27 /*
28 * .. Scalar Arguments ..
29 */
30  char * UPLO;
31  int IOFFD, K, LDAC, LDAR, LDBC, LDBR, LDC, M, N;
32  char * ALPHA;
33 /*
34 * .. Array Arguments ..
35 */
36  char * AC, * AR, * BC, * BR, * C;
37  PBTYP_T * TYPE;
38 #endif
39 {
40 /*
41 * Purpose
42 * =======
43 *
44 * PB_Ctzher2k performs the trapezoidal symmetric or Hermitian rank k
45 * operation:
46 *
47 * C := alpha * AC * AR + C,
48 *
49 * where alpha is a scalar, AC is an m by k matrix, AR is an k by n ma-
50 * trix and C is an m by n trapezoidal symmetric or Hermitian matrix.
51 *
52 * Arguments
53 * =========
54 *
55 * TYPE (local input) pointer to a PBTYP_T structure
56 * On entry, TYPE is a pointer to a structure of type PBTYP_T,
57 * that contains type information (See pblas.h).
58 *
59 * UPLO (input) pointer to CHAR
60 * On entry, UPLO specifies which part of the matrix C is to be
61 * referenced as follows:
62 *
63 * UPLO = 'L' or 'l' the lower trapezoid of C is referenced,
64 *
65 * UPLO = 'U' or 'u' the upper trapezoid of C is referenced,
66 *
67 * otherwise all of the matrix C is referenced.
68 *
69 * M (input) INTEGER
70 * On entry, M specifies the number of rows of the matrix C. M
71 * must be at least zero.
72 *
73 * N (input) INTEGER
74 * On entry, N specifies the number of columns of the matrix C.
75 * N must be at least zero.
76 *
77 * K (input) INTEGER
78 * On entry, K specifies the number of columns of the matrix AC,
79 * and the number of rows of the matrix AR. K must be at least
80 * zero.
81 *
82 * IOFFD (input) INTEGER
83 * On entry, IOFFD specifies the position of the offdiagonal de-
84 * limiting the upper and lower trapezoidal part of C as follows
85 * (see the notes below):
86 *
87 * IOFFD = 0 specifies the main diagonal C( i, i ),
88 * with i = 1 ... MIN( M, N ),
89 * IOFFD > 0 specifies the subdiagonal C( i+IOFFD, i ),
90 * with i = 1 ... MIN( M-IOFFD, N ),
91 * IOFFD < 0 specifies the superdiagonal C( i, i-IOFFD ),
92 * with i = 1 ... MIN( M, N+IOFFD ).
93 *
94 * ALPHA (input) pointer to CHAR
95 * On entry, ALPHA specifies the scalar alpha.
96 *
97 * AC (input) pointer to CHAR
98 * On entry, AC is an array of dimension (LDAC,K) containing the
99 * m by k matrix AC.
100 *
101 * LDAC (input) INTEGER
102 * On entry, LDAC specifies the leading dimension of the array
103 * AC. LDAC must be at least max( 1, M ).
104 *
105 * AR (input) pointer to CHAR
106 * On entry, AR is an array of dimension (LDAR,N) containing the
107 * k by n matrix AR.
108 *
109 * LDAR (input) INTEGER
110 * On entry, LDAR specifies the leading dimension of the array
111 * AR. LDAR must be at least K.
112 *
113 * C (input/output) pointer to CHAR
114 * On entry, C is an array of dimension (LDC,N) containing the m
115 * by n matrix A. Only the trapezoidal part of C determined by
116 * UPLO and IOFFD is updated.
117 *
118 * LDC (input) INTEGER
119 * On entry, LDC specifies the leading dimension of the array C.
120 * LDC must be at least max( 1, M ).
121 *
122 * Notes
123 * =====
124 * N N
125 * ---------------------------- -----------
126 * | d | | |
127 * M | d Upper | | Upper |
128 * | Lower d | |d |
129 * | d | M | d |
130 * ---------------------------- | d |
131 * | d |
132 * IOFFD < 0 | Lower d |
133 * | d|
134 * N | |
135 * ----------- -----------
136 * | d Upper|
137 * | d | IOFFD > 0
138 * M | d |
139 * | d| N
140 * | Lower | ----------------------------
141 * | | | Upper |
142 * | | |d |
143 * | | | d |
144 * | | | d |
145 * | | |Lower d |
146 * ----------- ----------------------------
147 *
148 * -- Written on April 1, 1998 by
149 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
150 *
151 * ---------------------------------------------------------------------
152 */
153 /*
154 * .. Local Scalars ..
155 */
156  char * Calph, * one, type;
157  int i1, j1, m1, mn, n1, size;
158  cmplx Calph8;
159  cmplx16 Calph16;
160  GEMM_T gemm;
161 /* ..
162 * .. Executable Statements ..
163 *
164 */
165  if( ( M <= 0 ) || ( N <= 0 ) ) return;
166 
167  type = TYPE->type;
168 
169  if( type == SCPLX )
170  { Calph = ( (char *)(Calph8 ) ); PB_Cconjg( TYPE, ALPHA, Calph ); }
171  else if( type == DCPLX )
172  { Calph = ( (char *)(Calph16) ); PB_Cconjg( TYPE, ALPHA, Calph ); }
173  else
174  { Calph = ALPHA; }
175 
176  if( Mupcase( UPLO[0] ) == CLOWER )
177  {
178  size = TYPE->size; one = TYPE->one; gemm = TYPE->Fgemm;
179  mn = MAX( 0, -IOFFD );
180  if( ( n1 = MIN( mn, N ) ) > 0 )
181  {
182  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &M, &n1, &K, ALPHA, AC,
183  &LDAC, BR, &LDBR, one, C, &LDC );
184  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &M, &n1, &K, Calph, BC,
185  &LDBC, AR, &LDAR, one, C, &LDC );
186  }
187  n1 = M - IOFFD;
188  if( ( n1 = MIN( n1, N ) - mn ) > 0 )
189  {
190  i1 = ( j1 = mn ) + IOFFD;
191  TYPE->Fher2k( C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ), &n1, &K, ALPHA,
192  Mptr( AC, i1, 0, LDAC, size ), &LDAC, Mptr( BC, i1, 0,
193  LDBC, size ), &LDBC, one, Mptr( C, i1, j1, LDC, size ),
194  &LDC );
195  if( ( m1 = M - mn - n1 - IOFFD ) > 0 )
196  {
197  i1 += n1;
198  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &m1, &n1, &K, ALPHA,
199  Mptr( AC, i1, 0, LDAC, size ), &LDAC, Mptr( BR, 0, j1, LDBR,
200  size ), &LDBR, one, Mptr( C, i1, j1, LDC, size ), &LDC );
201  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &m1, &n1, &K, Calph,
202  Mptr( BC, i1, 0, LDBC, size ), &LDBC, Mptr( AR, 0, j1, LDAR,
203  size ), &LDAR, one, Mptr( C, i1, j1, LDC, size ), &LDC );
204  }
205  }
206  }
207  else if( Mupcase( UPLO[0] ) == CUPPER )
208  {
209  size = TYPE->size; one = TYPE->one; gemm = TYPE->Fgemm;
210  mn = M - IOFFD; mn = MIN( mn, N );
211  if( ( n1 = mn - MAX( 0, -IOFFD ) ) > 0 )
212  {
213  j1 = mn - n1;
214  if( ( m1 = MAX( 0, IOFFD ) ) > 0 )
215  {
216  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &m1, &n1, &K, ALPHA,
217  AC, &LDAC, BR, &LDBR, one, C, &LDC );
218  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &m1, &n1, &K, Calph,
219  BC, &LDBC, AR, &LDAR, one, C, &LDC );
220  }
221  TYPE->Fher2k( C2F_CHAR( UPLO ), C2F_CHAR( NOTRAN ), &n1, &K, ALPHA,
222  Mptr( AC, m1, 0, LDAC, size ), &LDAC, Mptr( BC, m1, 0,
223  LDBC, size ), &LDBC, one, Mptr( C, m1, j1, LDC, size ),
224  &LDC );
225  }
226  if( ( n1 = N - MAX( 0, mn ) ) > 0 )
227  {
228  j1 = N - n1;
229  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &M, &n1, &K, ALPHA, AC,
230  &LDAC, Mptr( BR, 0, j1, LDBR, size ), &LDBR, one, Mptr( C, 0, j1,
231  LDC, size ), &LDC );
232  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &M, &n1, &K, Calph, BC,
233  &LDBC, Mptr( AR, 0, j1, LDAR, size ), &LDAR, one, Mptr( C, 0, j1,
234  LDC, size ), &LDC );
235  }
236  }
237  else
238  {
239  one = TYPE->one; gemm = TYPE->Fgemm;
240  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &M, &N, &K, ALPHA, AC,
241  &LDAC, BR, &LDBR, one, C, &LDC );
242  gemm( C2F_CHAR( NOTRAN ), C2F_CHAR( NOTRAN ), &M, &N, &K, Calph, BC,
243  &LDBC, AR, &LDAR, one, C, &LDC );
244  }
245 /*
246 * End of PB_Ctzher2k
247 */
248 }
cmplx
float cmplx[2]
Definition: pblas.h:132
TYPE
#define TYPE
Definition: clamov.c:7
PB_Cconjg
void PB_Cconjg()
PB_Ctzher2k
void PB_Ctzher2k(PBTYP_T *TYPE, char *UPLO, int M, int N, int K, int IOFFD, char *ALPHA, char *AC, int LDAC, char *BC, int LDBC, char *AR, int LDAR, char *BR, int LDBR, char *C, int LDC)
Definition: PB_Ctzher2k.c:25
GEMM_T
F_VOID_FCT(* GEMM_T)()
Definition: pblas.h:313
NOTRAN
#define NOTRAN
Definition: PBblas.h:44
DCPLX
#define DCPLX
Definition: pblas.h:472
CLOWER
#define CLOWER
Definition: PBblas.h:25
cmplx16
double cmplx16[2]
Definition: pblas.h:133
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
SCPLX
#define SCPLX
Definition: pblas.h:471