OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pbzvecadd.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine pbzvecadd (icontxt, mode, n, alpha, x, incx, beta, y, incy)

Function/Subroutine Documentation

◆ pbzvecadd()

subroutine pbzvecadd ( integer icontxt,
character*1 mode,
integer n,
complex*16 alpha,
complex*16, dimension( * ) x,
integer incx,
complex*16 beta,
complex*16, dimension( * ) y,
integer incy )

Definition at line 1 of file pbzvecadd.f.

3*
4* -- PB-BLAS routine (version 2.1) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory.
6* April 28, 1996
7*
8* .. Scalar Arguments ..
9 CHARACTER*1 MODE
10 INTEGER ICONTXT, INCX, INCY, N
11 COMPLEX*16 ALPHA, BETA
12* ..
13* .. Array Arguments ..
14 COMPLEX*16 X( * ), Y( * )
15*
16* ..
17*
18* Purpose
19* =======
20*
21* PBZVECADD performs a vector X to be added to Y
22* Y := alpha*op(X) + beta*Y,
23* where alpha and beta are scalars, and X and Y are n vectors,
24* and op(X) = X**H if MODE = 'C',
25*
26* Arguments
27* =========
28*
29* ICONTXT (input) INTEGER
30* ICONTXT is the BLACS mechanism for partitioning communication
31* space. A defining property of a context is that a message in
32* a context cannot be sent or received in another context. The
33* BLACS context includes the definition of a grid, and each
34* process' coordinates in it.
35*
36* MODE (input) CHARACTER*1
37* Specifies the transposed, or conjugate transposed vector X
38* to be added to the vector Y
39* = 'C': Conjugate vector X is added for complex data set.
40* Y = alpha * X**H + beta * Y
41* ELSE : Vector X is added. Y = alpha*X + beta*Y
42* if MODE = 'V', BLAS routine may be used.
43*
44* N (input) INTEGER
45* The number of elements of the vectors X and Y to be added.
46* N >= 0.
47*
48* ALPHA (input) COMPLEX*16
49* ALPHA specifies the scalar alpha.
50*
51* X (input) COMPLEX*16 array of DIMENSION at least
52* ( 1 + ( N - 1 )*abs( INCX ) )
53* The incremented array X must contain the vector X.
54*
55* INCX (input) INTEGER
56* INCX specifies the increment for the elements of X.
57* INCX <> 0.
58*
59* BETA (input) COMPLEX*16
60* BETA specifies the scalar beta.
61*
62* Y (input/output) COMPLEX*16 array of DIMENSION at least
63* ( 1 + ( N - 1 )*abs( INCY ) )
64* On entry with BETA non-zero, the incremented array Y must
65* contain the vector Y.
66* On exit, Y is overwritten by the updated vector Y.
67*
68* INCY - (input) INTEGER
69* INCY specifies the increment for the elements of Y.
70* INCY <> 0.
71*
72* =====================================================================
73*
74* ..
75* .. Parameters ..
76 COMPLEX*16 ZERO, ONE
77 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
78 parameter( one = ( 1.0d+0, 0.0d+0 ) )
79* ..
80* .. Local Scalars ..
81 INTEGER I, IX, IY
82* ..
83* .. External Functions ..
84 LOGICAL LSAME
85 EXTERNAL lsame
86* ..
87* .. External Subroutines ..
88 EXTERNAL zscal, zcopy, zaxpy
89* ..
90* .. Intrinsic Functions ..
91 INTRINSIC dconjg
92* ..
93* .. Executable Statements ..
94*
95 IF( n.LE.0 .OR. ( alpha.EQ.zero .AND. beta.EQ.one ) ) RETURN
96*
97 IF( alpha.EQ.zero ) THEN
98 IF( beta.EQ.zero ) THEN
99 IF( incy.EQ.1 ) THEN
100 DO 10 i = 1, n
101 y( i ) = zero
102 10 CONTINUE
103 ELSE
104 iy = 1
105 DO 20 i = 1, n
106 y( iy ) = zero
107 iy = iy + incy
108 20 CONTINUE
109 END IF
110*
111 ELSE
112 IF( lsame( mode, 'V' ) ) THEN
113 CALL zscal( n, beta, y, incy )
114 ELSE IF( incy.EQ.1 ) THEN
115 DO 30 i = 1, n
116 y( i ) = beta * y( i )
117 30 CONTINUE
118 ELSE
119 iy = 1
120 DO 40 i = 1, n
121 y( iy ) = beta * y( iy )
122 iy = iy + incy
123 40 CONTINUE
124 END IF
125 END IF
126*
127 ELSE IF( .NOT.lsame( mode, 'C' ) ) THEN
128 IF( alpha.EQ.one ) THEN
129 IF( beta.EQ.zero ) THEN
130 IF( lsame( mode, 'v' ) ) THEN
131 CALL ZCOPY( N, X, INCX, Y, INCY )
132.EQ..AND..EQ. ELSE IF( INCX1 INCY1 ) THEN
133 DO 50 I = 1, N
134 Y( I ) = X( I )
135 50 CONTINUE
136 ELSE
137 IX = 1
138 IY = 1
139 DO 60 I = 1, N
140 Y( IY ) = X( IX )
141 IX = IX + INCX
142 IY = IY + INCY
143 60 CONTINUE
144 END IF
145*
146.EQ. ELSE IF( BETAONE ) THEN
147.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
148 DO 70 I = 1, N
149 Y( I ) = X( I ) + Y( I )
150 70 CONTINUE
151 ELSE
152 IX = 1
153 IY = 1
154 DO 80 I = 1, N
155 Y( IY ) = X( IX ) + Y( IY )
156 IX = IX + INCX
157 IY = IY + INCY
158 80 CONTINUE
159 END IF
160*
161 ELSE
162.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
163 DO 90 I = 1, N
164 Y( I ) = X( I ) + BETA * Y( I )
165 90 CONTINUE
166 ELSE
167 IX = 1
168 IY = 1
169 DO 100 I = 1, N
170 Y( IY ) = X( IX ) + BETA * Y( IY )
171 IX = IX + INCX
172 IY = IY + INCY
173 100 CONTINUE
174 END IF
175 END IF
176*
177 ELSE
178.EQ. IF( BETAZERO ) THEN
179.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
180 DO 110 I = 1, N
181 Y( I ) = ALPHA * X( I )
182 110 CONTINUE
183 ELSE
184 IX = 1
185 IY = 1
186 DO 120 I = 1, N
187 Y( IY ) = X( IX )
188 IX = IX + INCX
189 IY = IY + INCY
190 120 CONTINUE
191 END IF
192*
193.EQ. ELSE IF( BETAONE ) THEN
194 IF( LSAME( MODE, 'v' ) ) THEN
195 CALL ZAXPY( N, ALPHA, X, INCX, Y, INCY )
196.EQ..AND..EQ. ELSE IF( INCX1 INCY1 ) THEN
197 DO 130 I = 1, N
198 Y( I ) = ALPHA * X( I ) + Y( I )
199 130 CONTINUE
200 ELSE
201 IX = 1
202 IY = 1
203 DO 140 I = 1, N
204 Y( IY ) = ALPHA * X( IX ) + Y( IY )
205 IX = IX + INCX
206 IY = IY + INCY
207 140 CONTINUE
208 END IF
209*
210 ELSE
211.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
212 DO 150 I = 1, N
213 Y( I ) = ALPHA * X( I ) + BETA * Y( I )
214 150 CONTINUE
215 ELSE
216 IX = 1
217 IY = 1
218 DO 160 I = 1, N
219 Y( IY ) = ALPHA * X( IX ) + BETA * Y( IY )
220 IX = IX + INCX
221 IY = IY + INCY
222 160 CONTINUE
223 END IF
224 END IF
225 END IF
226*
227 ELSE
228.EQ. IF( ALPHAONE ) THEN
229.EQ. IF( BETAZERO ) THEN
230.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
231 DO 170 I = 1, N
232 Y( I ) = DCONJG( X( I ) )
233 170 CONTINUE
234 ELSE
235 IX = 1
236 IY = 1
237 DO 180 I = 1, N
238 Y( IY ) = DCONJG( X( IX ) )
239 IX = IX + INCX
240 IY = IY + INCY
241 180 CONTINUE
242 END IF
243*
244.EQ. ELSE IF( BETAONE ) THEN
245.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
246 DO 190 I = 1, N
247 Y( I ) = DCONJG( X( I ) ) + Y( I )
248 190 CONTINUE
249 ELSE
250 IX = 1
251 IY = 1
252 DO 200 I = 1, N
253 Y( IY ) = DCONJG( X( IX ) ) + Y( IY )
254 IX = IX + INCX
255 IY = IY + INCY
256 200 CONTINUE
257 END IF
258*
259 ELSE
260.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
261 DO 210 I = 1, N
262 Y( I ) = DCONJG( X( I ) ) + BETA * Y( I )
263 210 CONTINUE
264 ELSE
265 IX = 1
266 IY = 1
267 DO 220 I = 1, N
268 Y( IY ) = DCONJG( X( IX ) ) + BETA * Y( IY )
269 IX = IX + INCX
270 IY = IY + INCY
271 220 CONTINUE
272 END IF
273 END IF
274*
275 ELSE
276.EQ. IF( BETAZERO ) THEN
277.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
278 DO 230 I = 1, N
279 Y( I ) = ALPHA * DCONJG( X( I ) )
280 230 CONTINUE
281 ELSE
282 IX = 1
283 IY = 1
284 DO 240 I = 1, N
285 Y( IY ) = ALPHA * DCONJG( X( IX ) )
286 IX = IX + INCX
287 IY = IY + INCY
288 240 CONTINUE
289 END IF
290*
291.EQ. ELSE IF( BETAONE ) THEN
292.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
293 DO 250 I = 1, N
294 Y( I ) = ALPHA * DCONJG( X( I ) ) + Y( I )
295 250 CONTINUE
296 ELSE
297 IX = 1
298 IY = 1
299 DO 260 I = 1, N
300 Y( IY ) = ALPHA * DCONJG( X( IX ) ) + Y( IY )
301 IX = IX + INCX
302 IY = IY + INCY
303 260 CONTINUE
304 END IF
305*
306 ELSE
307.EQ..AND..EQ. IF( INCX1 INCY1 ) THEN
308 DO 270 I = 1, N
309 Y( I ) = ALPHA * DCONJG( X( I ) ) + BETA * Y( I )
310 270 CONTINUE
311 ELSE
312 IX = 1
313 IY = 1
314 DO 280 I = 1, N
315 Y( IY ) = ALPHA * DCONJG( X(IX) ) + BETA * Y( IY )
316 IX = IX + INCX
317 IY = IY + INCY
318 280 CONTINUE
319 END IF
320 END IF
321 END IF
322 END IF
323*
324 RETURN
325*
326* End of PBZVECADD
327*
alpha
#define alpha
Definition eval.h:35
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
zcopy
subroutine zcopy(n, zx, incx, zy, incy)
ZCOPY
Definition zcopy.f:81
zaxpy
subroutine zaxpy(n, za, zx, incx, zy, incy)
ZAXPY
Definition zaxpy.f:88
zscal
subroutine zscal(n, za, zx, incx)
ZSCAL
Definition zscal.f:78