|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
|
ScaLAPACK
2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
|
00001 SUBROUTINE PBZVECADD( ICONTXT, MODE, N, ALPHA, X, INCX, BETA, Y, 00002 $ INCY ) 00003 * 00004 * -- PB-BLAS routine (version 2.1) -- 00005 * University of Tennessee, Knoxville, Oak Ridge National Laboratory. 00006 * April 28, 1996 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER*1 MODE 00010 INTEGER ICONTXT, INCX, INCY, N 00011 COMPLEX*16 ALPHA, BETA 00012 * .. 00013 * .. Array Arguments .. 00014 COMPLEX*16 X( * ), Y( * ) 00015 * 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * PBZVECADD performs a vector X to be added to Y 00022 * Y := alpha*op(X) + beta*Y, 00023 * where alpha and beta are scalars, and X and Y are n vectors, 00024 * and op(X) = X**H if MODE = 'C', 00025 * 00026 * Arguments 00027 * ========= 00028 * 00029 * ICONTXT (input) INTEGER 00030 * ICONTXT is the BLACS mechanism for partitioning communication 00031 * space. A defining property of a context is that a message in 00032 * a context cannot be sent or received in another context. The 00033 * BLACS context includes the definition of a grid, and each 00034 * process' coordinates in it. 00035 * 00036 * MODE (input) CHARACTER*1 00037 * Specifies the transposed, or conjugate transposed vector X 00038 * to be added to the vector Y 00039 * = 'C': Conjugate vector X is added for complex data set. 00040 * Y = alpha * X**H + beta * Y 00041 * ELSE : Vector X is added. Y = alpha*X + beta*Y 00042 * if MODE = 'V', BLAS routine may be used. 00043 * 00044 * N (input) INTEGER 00045 * The number of elements of the vectors X and Y to be added. 00046 * N >= 0. 00047 * 00048 * ALPHA (input) COMPLEX*16 00049 * ALPHA specifies the scalar alpha. 00050 * 00051 * X (input) COMPLEX*16 array of DIMENSION at least 00052 * ( 1 + ( N - 1 )*abs( INCX ) ) 00053 * The incremented array X must contain the vector X. 00054 * 00055 * INCX (input) INTEGER 00056 * INCX specifies the increment for the elements of X. 00057 * INCX <> 0. 00058 * 00059 * BETA (input) COMPLEX*16 00060 * BETA specifies the scalar beta. 00061 * 00062 * Y (input/output) COMPLEX*16 array of DIMENSION at least 00063 * ( 1 + ( N - 1 )*abs( INCY ) ) 00064 * On entry with BETA non-zero, the incremented array Y must 00065 * contain the vector Y. 00066 * On exit, Y is overwritten by the updated vector Y. 00067 * 00068 * INCY - (input) INTEGER 00069 * INCY specifies the increment for the elements of Y. 00070 * INCY <> 0. 00071 * 00072 * ===================================================================== 00073 * 00074 * .. 00075 * .. Parameters .. 00076 COMPLEX*16 ZERO, ONE 00077 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ) ) 00078 PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) ) 00079 * .. 00080 * .. Local Scalars .. 00081 INTEGER I, IX, IY 00082 * .. 00083 * .. External Functions .. 00084 LOGICAL LSAME 00085 EXTERNAL LSAME 00086 * .. 00087 * .. External Subroutines .. 00088 EXTERNAL ZSCAL, ZCOPY, ZAXPY 00089 * .. 00090 * .. Intrinsic Functions .. 00091 INTRINSIC DCONJG 00092 * .. 00093 * .. Executable Statements .. 00094 * 00095 IF( N.LE.0 .OR. ( ALPHA.EQ.ZERO .AND. BETA.EQ.ONE ) ) RETURN 00096 * 00097 IF( ALPHA.EQ.ZERO ) THEN 00098 IF( BETA.EQ.ZERO ) THEN 00099 IF( INCY.EQ.1 ) THEN 00100 DO 10 I = 1, N 00101 Y( I ) = ZERO 00102 10 CONTINUE 00103 ELSE 00104 IY = 1 00105 DO 20 I = 1, N 00106 Y( IY ) = ZERO 00107 IY = IY + INCY 00108 20 CONTINUE 00109 END IF 00110 * 00111 ELSE 00112 IF( LSAME( MODE, 'V' ) ) THEN 00113 CALL ZSCAL( N, BETA, Y, INCY ) 00114 ELSE IF( INCY.EQ.1 ) THEN 00115 DO 30 I = 1, N 00116 Y( I ) = BETA * Y( I ) 00117 30 CONTINUE 00118 ELSE 00119 IY = 1 00120 DO 40 I = 1, N 00121 Y( IY ) = BETA * Y( IY ) 00122 IY = IY + INCY 00123 40 CONTINUE 00124 END IF 00125 END IF 00126 * 00127 ELSE IF( .NOT.LSAME( MODE, 'C' ) ) THEN 00128 IF( ALPHA.EQ.ONE ) THEN 00129 IF( BETA.EQ.ZERO ) THEN 00130 IF( LSAME( MODE, 'V' ) ) THEN 00131 CALL ZCOPY( N, X, INCX, Y, INCY ) 00132 ELSE IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00133 DO 50 I = 1, N 00134 Y( I ) = X( I ) 00135 50 CONTINUE 00136 ELSE 00137 IX = 1 00138 IY = 1 00139 DO 60 I = 1, N 00140 Y( IY ) = X( IX ) 00141 IX = IX + INCX 00142 IY = IY + INCY 00143 60 CONTINUE 00144 END IF 00145 * 00146 ELSE IF( BETA.EQ.ONE ) THEN 00147 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00148 DO 70 I = 1, N 00149 Y( I ) = X( I ) + Y( I ) 00150 70 CONTINUE 00151 ELSE 00152 IX = 1 00153 IY = 1 00154 DO 80 I = 1, N 00155 Y( IY ) = X( IX ) + Y( IY ) 00156 IX = IX + INCX 00157 IY = IY + INCY 00158 80 CONTINUE 00159 END IF 00160 * 00161 ELSE 00162 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00163 DO 90 I = 1, N 00164 Y( I ) = X( I ) + BETA * Y( I ) 00165 90 CONTINUE 00166 ELSE 00167 IX = 1 00168 IY = 1 00169 DO 100 I = 1, N 00170 Y( IY ) = X( IX ) + BETA * Y( IY ) 00171 IX = IX + INCX 00172 IY = IY + INCY 00173 100 CONTINUE 00174 END IF 00175 END IF 00176 * 00177 ELSE 00178 IF( BETA.EQ.ZERO ) THEN 00179 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00180 DO 110 I = 1, N 00181 Y( I ) = ALPHA * X( I ) 00182 110 CONTINUE 00183 ELSE 00184 IX = 1 00185 IY = 1 00186 DO 120 I = 1, N 00187 Y( IY ) = X( IX ) 00188 IX = IX + INCX 00189 IY = IY + INCY 00190 120 CONTINUE 00191 END IF 00192 * 00193 ELSE IF( BETA.EQ.ONE ) THEN 00194 IF( LSAME( MODE, 'V' ) ) THEN 00195 CALL ZAXPY( N, ALPHA, X, INCX, Y, INCY ) 00196 ELSE IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00197 DO 130 I = 1, N 00198 Y( I ) = ALPHA * X( I ) + Y( I ) 00199 130 CONTINUE 00200 ELSE 00201 IX = 1 00202 IY = 1 00203 DO 140 I = 1, N 00204 Y( IY ) = ALPHA * X( IX ) + Y( IY ) 00205 IX = IX + INCX 00206 IY = IY + INCY 00207 140 CONTINUE 00208 END IF 00209 * 00210 ELSE 00211 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00212 DO 150 I = 1, N 00213 Y( I ) = ALPHA * X( I ) + BETA * Y( I ) 00214 150 CONTINUE 00215 ELSE 00216 IX = 1 00217 IY = 1 00218 DO 160 I = 1, N 00219 Y( IY ) = ALPHA * X( IX ) + BETA * Y( IY ) 00220 IX = IX + INCX 00221 IY = IY + INCY 00222 160 CONTINUE 00223 END IF 00224 END IF 00225 END IF 00226 * 00227 ELSE 00228 IF( ALPHA.EQ.ONE ) THEN 00229 IF( BETA.EQ.ZERO ) THEN 00230 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00231 DO 170 I = 1, N 00232 Y( I ) = DCONJG( X( I ) ) 00233 170 CONTINUE 00234 ELSE 00235 IX = 1 00236 IY = 1 00237 DO 180 I = 1, N 00238 Y( IY ) = DCONJG( X( IX ) ) 00239 IX = IX + INCX 00240 IY = IY + INCY 00241 180 CONTINUE 00242 END IF 00243 * 00244 ELSE IF( BETA.EQ.ONE ) THEN 00245 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00246 DO 190 I = 1, N 00247 Y( I ) = DCONJG( X( I ) ) + Y( I ) 00248 190 CONTINUE 00249 ELSE 00250 IX = 1 00251 IY = 1 00252 DO 200 I = 1, N 00253 Y( IY ) = DCONJG( X( IX ) ) + Y( IY ) 00254 IX = IX + INCX 00255 IY = IY + INCY 00256 200 CONTINUE 00257 END IF 00258 * 00259 ELSE 00260 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00261 DO 210 I = 1, N 00262 Y( I ) = DCONJG( X( I ) ) + BETA * Y( I ) 00263 210 CONTINUE 00264 ELSE 00265 IX = 1 00266 IY = 1 00267 DO 220 I = 1, N 00268 Y( IY ) = DCONJG( X( IX ) ) + BETA * Y( IY ) 00269 IX = IX + INCX 00270 IY = IY + INCY 00271 220 CONTINUE 00272 END IF 00273 END IF 00274 * 00275 ELSE 00276 IF( BETA.EQ.ZERO ) THEN 00277 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00278 DO 230 I = 1, N 00279 Y( I ) = ALPHA * DCONJG( X( I ) ) 00280 230 CONTINUE 00281 ELSE 00282 IX = 1 00283 IY = 1 00284 DO 240 I = 1, N 00285 Y( IY ) = ALPHA * DCONJG( X( IX ) ) 00286 IX = IX + INCX 00287 IY = IY + INCY 00288 240 CONTINUE 00289 END IF 00290 * 00291 ELSE IF( BETA.EQ.ONE ) THEN 00292 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00293 DO 250 I = 1, N 00294 Y( I ) = ALPHA * DCONJG( X( I ) ) + Y( I ) 00295 250 CONTINUE 00296 ELSE 00297 IX = 1 00298 IY = 1 00299 DO 260 I = 1, N 00300 Y( IY ) = ALPHA * DCONJG( X( IX ) ) + Y( IY ) 00301 IX = IX + INCX 00302 IY = IY + INCY 00303 260 CONTINUE 00304 END IF 00305 * 00306 ELSE 00307 IF( INCX.EQ.1 .AND. INCY.EQ.1 ) THEN 00308 DO 270 I = 1, N 00309 Y( I ) = ALPHA * DCONJG( X( I ) ) + BETA * Y( I ) 00310 270 CONTINUE 00311 ELSE 00312 IX = 1 00313 IY = 1 00314 DO 280 I = 1, N 00315 Y( IY ) = ALPHA * DCONJG( X(IX) ) + BETA * Y( IY ) 00316 IX = IX + INCX 00317 IY = IY + INCY 00318 280 CONTINUE 00319 END IF 00320 END IF 00321 END IF 00322 END IF 00323 * 00324 RETURN 00325 * 00326 * End of PBZVECADD 00327 * 00328 END
