ScaLAPACK  2.0.2 ScaLAPACK: Scalable Linear Algebra PACKage
pcsscal_.c
Go to the documentation of this file.
```00001 /* ---------------------------------------------------------------------
00002 *
00003 *  -- PBLAS 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 pcsscal_( int * N,
00021                float * ALPHA,
00022                float * X, int * IX, int * JX, int * DESCX, int * INCX )
00023 #else
00024 void pcsscal_( N, ALPHA, X, IX, JX, DESCX, INCX )
00025 /*
00026 *  .. Scalar Arguments ..
00027 */
00028    int            * INCX, * IX, * JX, * N;
00029    float          * ALPHA;
00030 /*
00031 *  .. Array Arguments ..
00032 */
00033    int            * DESCX;
00034    float          * X;
00035 #endif
00036 {
00037 /*
00038 *  Purpose
00039 *  =======
00040 *
00041 *  PCSSCAL multiplies an n element subvector sub( X ) by the real scalar
00042 *  alpha,
00043 *
00044 *  where
00045 *
00046 *     sub( X ) denotes X(IX,JX:JX+N-1) if INCX = M_X,
00047 *                      X(IX:IX+N-1,JX) if INCX = 1 and INCX <> M_X.
00048 *
00049 *  Notes
00050 *  =====
00051 *
00052 *  A description  vector  is associated with each 2D block-cyclicly dis-
00053 *  tributed matrix.  This  vector  stores  the  information  required to
00054 *  establish the  mapping  between a  matrix entry and its corresponding
00055 *  process and memory location.
00056 *
00057 *  In  the  following  comments,   the character _  should  be  read  as
00058 *  "of  the  distributed  matrix".  Let  A  be a generic term for any 2D
00059 *  block cyclicly distributed matrix.  Its description vector is DESC_A:
00060 *
00061 *  NOTATION         STORED IN       EXPLANATION
00062 *  ---------------- --------------- ------------------------------------
00063 *  DTYPE_A (global) DESCA[ DTYPE_ ] The descriptor type.
00064 *  CTXT_A  (global) DESCA[ CTXT_  ] The BLACS context handle, indicating
00065 *                                   the NPROW x NPCOL BLACS process grid
00066 *                                   A  is  distributed over. The context
00067 *                                   itself  is  global,  but  the handle
00068 *                                   (the integer value) may vary.
00069 *  M_A     (global) DESCA[ M_     ] The  number of rows in the distribu-
00070 *                                   ted matrix A, M_A >= 0.
00071 *  N_A     (global) DESCA[ N_     ] The number of columns in the distri-
00072 *                                   buted matrix A, N_A >= 0.
00073 *  IMB_A   (global) DESCA[ IMB_   ] The number of rows of the upper left
00074 *                                   block of the matrix A, IMB_A > 0.
00075 *  INB_A   (global) DESCA[ INB_   ] The  number  of columns of the upper
00076 *                                   left   block   of   the  matrix   A,
00077 *                                   INB_A > 0.
00078 *  MB_A    (global) DESCA[ MB_    ] The blocking factor used to  distri-
00079 *                                   bute the last  M_A-IMB_A  rows of A,
00080 *                                   MB_A > 0.
00081 *  NB_A    (global) DESCA[ NB_    ] The blocking factor used to  distri-
00082 *                                   bute the last  N_A-INB_A  columns of
00083 *                                   A, NB_A > 0.
00084 *  RSRC_A  (global) DESCA[ RSRC_  ] The process row over which the first
00085 *                                   row of the matrix  A is distributed,
00086 *                                   NPROW > RSRC_A >= 0.
00087 *  CSRC_A  (global) DESCA[ CSRC_  ] The  process column  over  which the
00088 *                                   first column of  A  is  distributed.
00089 *                                   NPCOL > CSRC_A >= 0.
00090 *  LLD_A   (local)  DESCA[ LLD_   ] The  leading dimension  of the local
00091 *                                   array  storing  the  local blocks of
00092 *                                   the distributed matrix A,
00093 *                                   IF( Lc( 1, N_A ) > 0 )
00094 *                                      LLD_A >= MAX( 1, Lr( 1, M_A ) )
00095 *                                   ELSE
00096 *                                      LLD_A >= 1.
00097 *
00098 *  Let K be the number of  rows of a matrix A starting at the global in-
00099 *  dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
00100 *  that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
00101 *  receive if these K rows were distributed over NPROW processes.  If  K
00102 *  is the number of columns of a matrix  A  starting at the global index
00103 *  JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number  of co-
00104 *  lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would  receive if
00105 *  these K columns were distributed over NPCOL processes.
00106 *
00107 *  The values of Lr() and Lc() may be determined via a call to the func-
00108 *  tion PB_Cnumroc:
00109 *  Lr( IA, K ) = PB_Cnumroc( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
00110 *  Lc( JA, K ) = PB_Cnumroc( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
00111 *
00112 *  Arguments
00113 *  =========
00114 *
00115 *  N       (global input) INTEGER
00116 *          On entry,  N  specifies the length of the subvector sub( X ).
00117 *          N must be at least zero.
00118 *
00119 *  ALPHA   (global input) REAL
00120 *          On entry, ALPHA specifies the scalar alpha.   When  ALPHA  is
00121 *          supplied as zero then the local entries of the array  X  cor-
00122 *          responding to the entries of the subvector sub( X ) need  not
00123 *          be set on input.
00124 *
00125 *  X       (local input/local output) COMPLEX array
00126 *          On entry, X is an array of dimension (LLD_X, Kx), where LLD_X
00127 *          is   at  least  MAX( 1, Lr( 1, IX ) )  when  INCX = M_X   and
00128 *          MAX( 1, Lr( 1, IX+N-1 ) )  otherwise,  and,  Kx  is  at least
00129 *          Lc( 1, JX+N-1 )  when  INCX = M_X  and Lc( 1, JX ) otherwise.
00130 *          Before  entry,  this array  contains the local entries of the
00131 *          matrix  X.  On exit, sub( X ) is overwritten with the  scaled
00132 *          subvector.
00133 *
00134 *  IX      (global input) INTEGER
00135 *          On entry, IX  specifies X's global row index, which points to
00136 *          the beginning of the submatrix sub( X ).
00137 *
00138 *  JX      (global input) INTEGER
00139 *          On entry, JX  specifies X's global column index, which points
00140 *          to the beginning of the submatrix sub( X ).
00141 *
00142 *  DESCX   (global and local input) INTEGER array
00143 *          On entry, DESCX  is an integer array of dimension DLEN_. This
00144 *          is the array descriptor for the matrix X.
00145 *
00146 *  INCX    (global input) INTEGER
00147 *          On entry,  INCX   specifies  the  global  increment  for  the
00148 *          elements of  X.  Only two values of  INCX   are  supported in
00149 *          this version, namely 1 and M_X. INCX  must not be zero.
00150 *
00151 *  -- Written on April 1, 1998 by
00152 *     Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
00153 *
00154 *  ---------------------------------------------------------------------
00155 */
00156 /*
00157 *  .. Local Scalars ..
00158 */
00159    int            Xcol, Xi, Xii, Xj, Xjj, Xld, Xnp, Xnq, Xrow, ctxt, info,
00160                   mycol, myrow, npcol, nprow;
00161    PBTYP_T        * type;
00162 /*
00163 *  .. Local Arrays ..
00164 */
00165    int            Xd[DLEN_];
00166 /* ..
00167 *  .. Executable Statements ..
00168 *
00169 */
00170    PB_CargFtoC( *IX, *JX, DESCX, &Xi, &Xj, Xd );
00171 #ifndef NO_ARGCHK
00172 /*
00173 *  Test the input parameters
00174 */
00175    Cblacs_gridinfo( ( ctxt = Xd[CTXT_] ), &nprow, &npcol, &myrow, &mycol );
00176    if( !( info = ( ( nprow == -1 ) ? -( 601 + CTXT_ ) : 0 ) ) )
00177       PB_Cchkvec( ctxt, "PCSSCAL", "X", *N, 1, Xi, Xj, Xd, *INCX, 6, &info );
00178    if( info ) { PB_Cabort( ctxt, "PCSSCAL", info ); return; }
00179 #endif
00180 /*
00181 *  Quick return if possible
00182 */
00183    if( ( *N == 0 ) || ( ALPHA[REAL_PART] == ONE ) ) return;
00184 /*
00185 *  Retrieve process grid information
00186 */
00187 #ifdef NO_ARGCHK
00188    Cblacs_gridinfo( Xd[CTXT_], &nprow, &npcol, &myrow, &mycol );
00189 #endif
00190 /*
00191 *  Retrieve sub( X )'s local information: Xii, Xjj, Xrow, Xcol
00192 */
00193    PB_Cinfog2l( Xi, Xj, Xd, nprow, npcol, myrow, mycol, &Xii, &Xjj, &Xrow,
00194                 &Xcol );
00195 /*
00196 *  Start the operations
00197 */
00198    if( *INCX == Xd[M_] )
00199    {
00200 /*
00201 *  sub( X ) resides in (a) process row(s)
00202 */
00203       if( ( myrow == Xrow ) || ( Xrow < 0 ) )
00204       {
00205 /*
00206 *  Make sure I own some data and scale sub( X )
00207 */
00208          Xnq = PB_Cnumroc( *N, Xj, Xd[INB_], Xd[NB_], mycol, Xd[CSRC_], npcol );
00209          if( Xnq > 0 )
00210          {
00211             Xld = Xd[LLD_];
00212             type = PB_Cctypeset();
00213             if( ALPHA[REAL_PART] == ZERO )
00214             {
00215                cset_( &Xnq, type->zero, Mptr( ((char *) X), Xii, Xjj, Xld,
00216                       type->size ), &Xld );
00217             }
00218             else
00219             {
00220                csscal_( &Xnq, ((char *) ALPHA), Mptr( ((char *) X),
00221                         Xii, Xjj, Xld, type->size ), &Xld );
00222             }
00223          }
00224       }
00225       return;
00226    }
00227    else
00228    {
00229 /*
00230 *  sub( X ) resides in (a) process column(s)
00231 */
00232       if( ( mycol == Xcol ) || ( Xcol < 0 ) )
00233       {
00234 /*
00235 *  Make sure I own some data and scale sub( X )
00236 */
00237          Xnp = PB_Cnumroc( *N, Xi, Xd[IMB_], Xd[MB_], myrow, Xd[RSRC_], nprow );
00238          if( Xnp > 0 )
00239          {
00240             type = PB_Cctypeset();
00241             if( ALPHA[REAL_PART] == ZERO )
00242             {
00243                cset_( &Xnp, type->zero, Mptr( ((char *) X), Xii, Xjj,
00244                       Xd[LLD_], type->size ), INCX );
00245             }
00246             else
00247             {
00248                csscal_( &Xnp, ((char *) ALPHA), Mptr( ((char *) X),
00249                         Xii, Xjj, Xd[LLD_], type->size ), INCX );
00250             }
00251          }
00252       }
00253       return;
00254    }
00255 /*
00256 *  End of PCSSCAL
00257 */
00258 }
```