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