ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
PB_Ctzhemv.c
Go to the documentation of this file.
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 }