|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
00001 /* --------------------------------------------------------------------- 00002 * 00003 * -- PBLAS auxiliary routine (version 2.0) -- 00004 * University of Tennessee, Knoxville, Oak Ridge National Laboratory, 00005 * and University of California, Berkeley. 00006 * April 1, 1998 00007 * 00008 * --------------------------------------------------------------------- 00009 */ 00010 /* 00011 * Include files 00012 */ 00013 #include "../pblas.h" 00014 #include "../PBpblas.h" 00015 #include "../PBtools.h" 00016 #include "../PBblacs.h" 00017 #include "../PBblas.h" 00018 00019 #ifdef __STDC__ 00020 void PB_Ctzhemv( PBTYP_T * TYPE, char * SIDE, char * UPLO, int M, int N, 00021 int K, int IOFFD, char * ALPHA, char * A, int LDA, 00022 char * XC, int LDXC, char * XR, int LDXR, char * YC, 00023 int LDYC, char * YR, int LDYR ) 00024 #else 00025 void PB_Ctzhemv( TYPE, SIDE, UPLO, M, N, K, IOFFD, ALPHA, A, LDA, XC, 00026 LDXC, XR, LDXR, YC, LDYC, YR, LDYR ) 00027 /* 00028 * .. Scalar Arguments .. 00029 */ 00030 char * SIDE, * UPLO; 00031 int IOFFD, K, LDA, LDXC, LDXR, LDYC, LDYR, M, N; 00032 char * ALPHA; 00033 /* 00034 * .. Array Arguments .. 00035 */ 00036 PBTYP_T * TYPE; 00037 char * A, * XC, * XR, * YC, * YR; 00038 #endif 00039 { 00040 /* 00041 * Purpose 00042 * ======= 00043 * 00044 * PB_Ctzhemv performs the matrix-vector operation 00045 * 00046 * y := alpha * A * x + y, 00047 * 00048 * where alpha is a scalar, x and y are n element vectors and A is an m 00049 * by n trapezoidal symmetric or Hermitian matrix. 00050 * 00051 * Arguments 00052 * ========= 00053 * 00054 * TYPE (local input) pointer to a PBTYP_T structure 00055 * On entry, TYPE is a pointer to a structure of type PBTYP_T, 00056 * that contains type information (See pblas.h). 00057 * 00058 * SIDE (dummy) pointer to CHAR 00059 * In this routine, SIDE is a dummy (unused) argument. 00060 * 00061 * UPLO (input) pointer to CHAR 00062 * On entry, UPLO specifies which part of the matrix A is to be 00063 * referenced as follows: 00064 * 00065 * UPLO = 'L' or 'l' the lower trapezoid of A is referenced, 00066 * 00067 * UPLO = 'U' or 'u' the upper trapezoid of A is referenced, 00068 * 00069 * otherwise all of the matrix A is referenced. 00070 * 00071 * M (input) INTEGER 00072 * On entry, M specifies the number of rows of the matrix A. M 00073 * must be at least zero. 00074 * 00075 * N (input) INTEGER 00076 * On entry, N specifies the number of columns of the matrix A. 00077 * N must be at least zero. 00078 * 00079 * K (dummy) INTEGER 00080 * In this routine, K is a dummy (unused) argument. 00081 * 00082 * IOFFD (input) INTEGER 00083 * On entry, IOFFD specifies the position of the offdiagonal de- 00084 * limiting the upper and lower trapezoidal part of A as follows 00085 * (see the notes below): 00086 * 00087 * IOFFD = 0 specifies the main diagonal A( i, i ), 00088 * with i = 1 ... MIN( M, N ), 00089 * IOFFD > 0 specifies the subdiagonal A( i+IOFFD, i ), 00090 * with i = 1 ... MIN( M-IOFFD, N ), 00091 * IOFFD < 0 specifies the superdiagonal A( i, i-IOFFD ), 00092 * with i = 1 ... MIN( M, N+IOFFD ). 00093 * 00094 * ALPHA (input) pointer to CHAR 00095 * On entry, ALPHA specifies the scalar alpha. 00096 * 00097 * A (input) pointer to CHAR 00098 * On entry, A is an array of dimension (LDA,N) containing the m 00099 * by n matrix A. Only the trapezoidal part of A determined by 00100 * UPLO and IOFFD is referenced. 00101 * 00102 * LDA (input) INTEGER 00103 * On entry, LDA specifies the leading dimension of the array A. 00104 * LDA must be at least max( 1, M ). 00105 * 00106 * XC (input) pointer to CHAR 00107 * On entry, XC is an array of dimension (LDXC,1) containing the 00108 * m by 1 vector XC. 00109 * 00110 * LDXC (input) INTEGER 00111 * On entry, LDXC specifies the leading dimension of the array 00112 * XC. LDXC must be at least max( 1, M ). 00113 * 00114 * XR (input) pointer to CHAR 00115 * On entry, XR is an array of dimension (LDXR,N) containing the 00116 * 1 by n vector XR. 00117 * 00118 * LDXR (input) INTEGER 00119 * On entry, LDXR specifies the leading dimension of the array 00120 * XR. LDXR must be at least 1. 00121 * 00122 * YC (input/output) pointer to CHAR 00123 * On entry, YC is an array of dimension (LDYC,1) containing the 00124 * m by 1 vector YC. On exit, YC is overwritten by the partially 00125 * updated vector y. 00126 * 00127 * LDYC (input) INTEGER 00128 * On entry, LDYC specifies the leading dimension of the array 00129 * YC. LDYC must be at least max( 1, M ). 00130 * 00131 * YR (input/output) pointer to CHAR 00132 * On entry, YR is an array of dimension (LDYR,N) containing the 00133 * 1 by n vector YR. On exit, YR is overwritten by the partially 00134 * updated vector y. 00135 * 00136 * LDYR (input) INTEGER 00137 * On entry, LDYR specifies the leading dimension of the array 00138 * YR. LDYR must be at least 1. 00139 * 00140 * Notes 00141 * ===== 00142 * N N 00143 * ---------------------------- ----------- 00144 * | d | | | 00145 * M | d Upper | | Upper | 00146 * | Lower d | |d | 00147 * | d | M | d | 00148 * ---------------------------- | d | 00149 * | d | 00150 * IOFFD < 0 | Lower d | 00151 * | d| 00152 * N | | 00153 * ----------- ----------- 00154 * | d Upper| 00155 * | d | IOFFD > 0 00156 * M | d | 00157 * | d| N 00158 * | Lower | ---------------------------- 00159 * | | | Upper | 00160 * | | |d | 00161 * | | | d | 00162 * | | | d | 00163 * | | |Lower d | 00164 * ----------- ---------------------------- 00165 * 00166 * -- Written on April 1, 1998 by 00167 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA. 00168 * 00169 * --------------------------------------------------------------------- 00170 */ 00171 /* 00172 * .. Local Scalars .. 00173 */ 00174 char * one; 00175 int i1, ione=1, j1, m1, mn, n1, size; 00176 GEMV_T gemv; 00177 /* .. 00178 * .. Executable Statements .. 00179 * 00180 */ 00181 if( ( M <= 0 ) || ( N <= 0 ) ) return; 00182 00183 if( Mupcase( UPLO[0] ) == CLOWER ) 00184 { 00185 size = TYPE->size; one = TYPE->one; gemv = TYPE->Fgemv; 00186 mn = MAX( 0, -IOFFD ); 00187 if( ( n1 = MIN( mn, N ) ) > 0 ) 00188 { 00189 gemv( C2F_CHAR( NOTRAN ), &M, &n1, ALPHA, A, &LDA, XR, &LDXR, one, YC, 00190 &ione ); 00191 gemv( C2F_CHAR( COTRAN ), &M, &n1, ALPHA, A, &LDA, XC, &ione, one, YR, 00192 &LDYR ); 00193 } 00194 n1 = M - IOFFD; 00195 if( ( n1 = MIN( n1, N ) - mn ) > 0 ) 00196 { 00197 i1 = ( j1 = mn ) + IOFFD; 00198 TYPE->Fhemv( C2F_CHAR( UPLO ), &n1, ALPHA, Mptr( A, i1, j1, LDA, 00199 size ), &LDA, Mptr( XC, i1, 0, LDXC, size ), &ione, one, 00200 Mptr( YC, i1, 0, LDYC, size ), &ione ); 00201 if( ( m1 = M - mn - n1 - IOFFD ) > 0 ) 00202 { 00203 i1 += n1; 00204 gemv( C2F_CHAR( NOTRAN ), &m1, &n1, ALPHA, Mptr( A, i1, j1, LDA, 00205 size ), &LDA, Mptr( XR, 0, j1, LDXR, size ), &LDXR, one, 00206 Mptr( YC, i1, 0, LDYC, size ), &ione ); 00207 gemv( C2F_CHAR( COTRAN ), &m1, &n1, ALPHA, Mptr( A, i1, j1, LDA, 00208 size ), &LDA, Mptr( XC, i1, 0, LDXC, size ), &ione, one, 00209 Mptr( YR, 0, j1, LDYR, size ), &LDYR ); 00210 } 00211 } 00212 } 00213 else if( Mupcase( UPLO[0] ) == CUPPER ) 00214 { 00215 size = TYPE->size; one = TYPE->one; gemv = TYPE->Fgemv; 00216 mn = M - IOFFD; mn = MIN( mn, N ); 00217 if( ( n1 = mn - MAX( 0, -IOFFD ) ) > 0 ) 00218 { 00219 j1 = mn - n1; 00220 if( ( m1 = MAX( 0, IOFFD ) ) > 0 ) 00221 { 00222 gemv( C2F_CHAR( NOTRAN ), &m1, &n1, ALPHA, A, &LDA, XR, &LDXR, one, 00223 YC, &ione ); 00224 gemv( C2F_CHAR( COTRAN ), &m1, &n1, ALPHA, A, &LDA, XC, &ione, one, 00225 YR, &LDYR ); 00226 } 00227 TYPE->Fhemv( C2F_CHAR( UPLO ), &n1, ALPHA, Mptr( A, m1, j1, LDA, 00228 size ), &LDA, Mptr( XC, m1, 0, LDXC, size ), &ione, one, 00229 Mptr( YC, m1, 0, LDYC, size ), &ione ); 00230 } 00231 if( ( n1 = N - MAX( 0, mn ) ) > 0 ) 00232 { 00233 j1 = N - n1; 00234 gemv( C2F_CHAR( NOTRAN ), &M, &n1, ALPHA, Mptr( A, 0, j1, LDA, size ), 00235 &LDA, Mptr( XR, 0, j1, LDXR, size ), &LDXR, one, YC, &ione ); 00236 gemv( C2F_CHAR( COTRAN ), &M, &n1, ALPHA, Mptr( A, 0, j1, LDA, size ), 00237 &LDA, XC, &ione, one, Mptr( YR, 0, j1, LDYR, size ), &LDYR ); 00238 } 00239 } 00240 else 00241 { 00242 one = TYPE->one; gemv = TYPE->Fgemv; 00243 gemv( C2F_CHAR( NOTRAN ), &M, &N, ALPHA, A, &LDA, XR, &LDXR, one, YC, 00244 &ione ); 00245 gemv( C2F_CHAR( COTRAN ), &M, &N, ALPHA, A, &LDA, XC, &ione, one, YR, 00246 &LDYR ); 00247 } 00248 /* 00249 * End of PB_Ctzhemv 00250 */ 00251 }