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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ pbcvecadd()

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

Definition at line 1 of file pbcvecadd.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 ALPHA, BETA
12* ..
13* .. Array Arguments ..
14 COMPLEX X( * ), Y( * )
15*
16* ..
17*
18* Purpose
19* =======
20*
21* PBCVECADD 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
49* ALPHA specifies the scalar alpha.
50*
51* X (input) COMPLEX 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
60* BETA specifies the scalar beta.
61*
62* Y (input/output) COMPLEX 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 ZERO, ONE
77 parameter( zero = ( 0.0e+0, 0.0e+0 ) )
78 parameter( one = ( 1.0e+0, 0.0e+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 cscal, ccopy, caxpy
89* ..
90* .. Intrinsic Functions ..
91 INTRINSIC conjg
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 cscal( 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 ccopy( n, x, incx, y, incy )
132 ELSE IF( incx.EQ.1 .AND. incy.EQ.1 ) 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 ELSE IF( beta.EQ.one ) THEN
147 IF( incx.EQ.1 .AND. incy.EQ.1 ) 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 IF( incx.EQ.1 .AND. incy.EQ.1 ) 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 IF( beta.EQ.zero ) THEN
179 IF( incx.EQ.1 .AND. incy.EQ.1 ) 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 ELSE IF( beta.EQ.one ) THEN
194 IF( lsame( mode, 'V' ) ) THEN
195 CALL caxpy( n, alpha, x, incx, y, incy )
196 ELSE IF( incx.EQ.1 .AND. incy.EQ.1 ) 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 IF( incx.EQ.1 .AND. incy.EQ.1 ) 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 IF( alpha.EQ.one ) THEN
229 IF( beta.EQ.zero ) THEN
230 IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
231 DO 170 i = 1, n
232 y( i ) = conjg( x( i ) )
233 170 CONTINUE
234 ELSE
235 ix = 1
236 iy = 1
237 DO 180 i = 1, n
238 y( iy ) = conjg( x( ix ) )
239 ix = ix + incx
240 iy = iy + incy
241 180 CONTINUE
242 END IF
243*
244 ELSE IF( beta.EQ.one ) THEN
245 IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
246 DO 190 i = 1, n
247 y( i ) = conjg( x( i ) ) + y( i )
248 190 CONTINUE
249 ELSE
250 ix = 1
251 iy = 1
252 DO 200 i = 1, n
253 y( iy ) = conjg( x( ix ) ) + y( iy )
254 ix = ix + incx
255 iy = iy + incy
256 200 CONTINUE
257 END IF
258*
259 ELSE
260 IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
261 DO 210 i = 1, n
262 y( i ) = conjg( 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 ) = conjg( 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 IF( beta.EQ.zero ) THEN
277 IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
278 DO 230 i = 1, n
279 y( i ) = alpha * conjg( x( i ) )
280 230 CONTINUE
281 ELSE
282 ix = 1
283 iy = 1
284 DO 240 i = 1, n
285 y( iy ) = alpha * conjg( x( ix ) )
286 ix = ix + incx
287 iy = iy + incy
288 240 CONTINUE
289 END IF
290*
291 ELSE IF( beta.EQ.one ) THEN
292 IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
293 DO 250 i = 1, n
294 y( i ) = alpha * conjg( 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 * conjg( x( ix ) ) + y( iy )
301 ix = ix + incx
302 iy = iy + incy
303 260 CONTINUE
304 END IF
305*
306 ELSE
307 IF( incx.EQ.1 .AND. incy.EQ.1 ) THEN
308 DO 270 i = 1, n
309 y( i ) = alpha * conjg( 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 * conjg( 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 PBCVECADD
327*
alpha
#define alpha
Definition eval.h:35
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:53
caxpy
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
Definition caxpy.f:88
ccopy
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
Definition ccopy.f:81
cscal
subroutine cscal(n, ca, cx, incx)
CSCAL
Definition cscal.f:78