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

Go to the source code of this file.

Functions/Subroutines

subroutine pbzmatadd (icontxt, mode, m, n, alpha, a, lda, beta, b, ldb)

Function/Subroutine Documentation

◆ pbzmatadd()

subroutine pbzmatadd ( integer icontxt,
character*1 mode,
integer m,
integer n,
complex*16 alpha,
complex*16, dimension( lda, * ) a,
integer lda,
complex*16 beta,
complex*16, dimension( ldb, * ) b,
integer ldb )

Definition at line 1 of file pbzmatadd.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, LDA, LDB, M, N
11 COMPLEX*16 ALPHA, BETA
12* ..
13* .. Array Arguments ..
14 COMPLEX*16 A( LDA, * ), B( LDB, * )
15* ..
16*
17* Purpose
18* =======
19*
20* PBZMATADD performs the matrix add operation B := alpha*A + beta*B,
21* where alpha and beta are scalars, and A and B are m-by-n
22* upper/lower trapezoidal matrices, or rectangular matrices.
23*
24* Arguments
25* =========
26*
27* ICONTXT (input) INTEGER
28* ICONTXT is the BLACS mechanism for partitioning communication
29* space. A defining property of a context is that a message in
30* a context cannot be sent or received in another context. The
31* BLACS context includes the definition of a grid, and each
32* process' coordinates in it.
33*
34* MODE (input) CHARACTER*1
35* Specifies the part of the matrix A, or (conjugate) transposed
36* matrix A to be added to the matrix B,
37* = 'U': Upper triangular part
38* up(B) = alpha*up(A) + beta*up(B)
39* = 'L': Lower triangular part
40* lo(B) = alpha*lo(A) + beta*lo(B)
41* = 'T': Transposed matrix A
42* B = alpha*A**T + beta*B
43* = 'C': Conjugate transposed matrix A
44* B = alpha*A**H + beta*B
45* Otherwise: B = alpha*A + beta*B
46* if M = LDA = LDB: use one BLAS loop
47* if MODE = 'V' : columnwise copy using BLAS if possible
48* else : use double loops
49*
50* M (input) INTEGER
51* M specifies the number of columns of the matrix A if
52* MODE != 'T'/'C', and it specifies the number of rows of the
53* matrix A otherwise. It also specifies the number of rows of
54* the matrix B. M >= 0.
55*
56* N (input) INTEGER
57* N specifies the number of rows of the matrix A if
58* MODE != 'T'/'C', and it specifies the number of columns of
59* the matrix A otherwise. It also specifies the number of
60* columns of the matrix B. N >= 0.
61*
62* ALPHA (input) COMPLEX*16
63* ALPHA specifies the scalar alpha.
64*
65* A (input) COMPLEX*16 array, dimension (LDA,N)
66* The m by n matrix A if MODE != 'T'/'C'.
67* If MODE = 'U', only the upper triangle or trapezoid is
68* accessed; if MODE = 'L', only the lower triangle or
69* trapezoid is accessed. Otherwise all m-by-n data matrix
70* is accessed.
71* And the n by m matrix A if MODE = 'T'/'C'.
72*
73* LDA (input) INTEGER
74* The leading dimension of the array A. LDA >= max(1,M) if
75* MODE != 'T'/'C'. And LDA >= max(1,N) if MODE = 'T'/'C'.
76*
77* BETA (input) COMPLEX*16
78* BETA specifies the scalar beta.
79*
80* B (input) COMPLEX*16 array, dimension (LDB,N)
81* On exit, B = alpha*A + beta*B
82*
83* LDB (input) INTEGER
84* The leading dimension of the array B. LDB >= max(1,M).
85*
86* =====================================================================
87*
88* .. Parameters ..
89 COMPLEX*16 ZERO, ONE
90 parameter( zero = ( 0.0d+0, 0.0d+0 ),
91 $ one = ( 1.0d+0, 0.0d+0 ) )
92* ..
93* .. Local Scalars ..
94 INTEGER I, J
95* ..
96* .. External Functions ..
97 LOGICAL LSAME
98 EXTERNAL lsame
99* ..
100* .. External Subroutines ..
101 EXTERNAL zscal, zcopy, zaxpy
102* ..
103* .. Intrinsic Functions ..
104 INTRINSIC min, dconjg
105* ..
106* .. Executable Statements ..
107*
108 IF( m.LE.0 .OR. n.LE.0 .OR. ( alpha.EQ.zero.AND.beta.EQ.one ) )
109 $ RETURN
110*
111* A is upper triangular or upper trapezoidal,
112*
113 IF( lsame( mode, 'U' ) ) THEN
114 IF( alpha.EQ.zero ) THEN
115 IF( beta.EQ.zero ) THEN
116 DO 20 j = 1, n
117 DO 10 i = 1, min( j, m )
118 b( i, j ) = zero
119 10 CONTINUE
120 20 CONTINUE
121 ELSE
122 DO 40 j = 1, n
123 DO 30 i = 1, min( j, m )
124 b( i, j ) = beta * b( i, j )
125 30 CONTINUE
126 40 CONTINUE
127 END IF
128*
129 ELSE IF( alpha.EQ.one ) THEN
130 IF( beta.EQ.zero ) THEN
131 DO 60 j = 1, n
132 DO 50 i = 1, min( j, m )
133 b( i, j ) = a( i, j )
134 50 CONTINUE
135 60 CONTINUE
136 ELSE IF( beta.EQ.one ) THEN
137 DO 80 j = 1, n
138 DO 70 i = 1, min( j, m )
139 b( i, j ) = a( i, j ) + b( i, j )
140 70 CONTINUE
141 80 CONTINUE
142 ELSE
143 DO 100 j = 1, n
144 DO 90 i = 1, min( j, m )
145 b( i, j ) = a( i, j ) + beta * b( i, j )
146 90 CONTINUE
147 100 CONTINUE
148 END IF
149*
150 ELSE
151 IF( beta.EQ.zero ) THEN
152 DO 120 j = 1, n
153 DO 110 i = 1, min( j, m )
154 b( i, j ) = alpha * a( i, j )
155 110 CONTINUE
156 120 CONTINUE
157 ELSE IF( beta.EQ.one ) THEN
158 DO 140 j = 1, n
159 DO 130 i = 1, min( j, m )
160 b( i, j ) = alpha * a( i, j ) + b( i, j )
161 130 CONTINUE
162 140 CONTINUE
163 ELSE
164 DO 160 j = 1, n
165 DO 150 i = 1, min( j, m )
166 b( i, j ) = alpha * a( i, j ) + beta * b( i, j )
167 150 CONTINUE
168 160 CONTINUE
169 END IF
170 END IF
171*
172* A is lower triangular or upper trapezoidal,
173*
174 ELSE IF( lsame( mode, 'L' ) ) THEN
175 IF( alpha.EQ.zero ) THEN
176 IF( beta.EQ.zero ) THEN
177 DO 180 j = 1, n
178 DO 170 i = j, m
179 b( i, j ) = zero
180 170 CONTINUE
181 180 CONTINUE
182 ELSE
183 DO 200 j = 1, n
184 DO 190 i = j, m
185 b( i, j ) = beta * b( i, j )
186 190 CONTINUE
187 200 CONTINUE
188 END IF
189*
190 ELSE IF( alpha.EQ.one ) THEN
191 IF( beta.EQ.zero ) THEN
192 DO 220 j = 1, n
193 DO 210 i = j, m
194 b( i, j ) = a( i, j )
195 210 CONTINUE
196 220 CONTINUE
197 ELSE IF( beta.EQ.one ) THEN
198 DO 240 j = 1, n
199 DO 230 i = j, m
200 b( i, j ) = a( i, j ) + b( i, j )
201 230 CONTINUE
202 240 CONTINUE
203 ELSE
204 DO 260 j = 1, n
205 DO 250 i = j, m
206 b( i, j ) = a( i, j ) + beta * b( i, j )
207 250 CONTINUE
208 260 CONTINUE
209 END IF
210*
211 ELSE
212 IF( beta.EQ.zero ) THEN
213 DO 280 j = 1, n
214 DO 270 i = j, m
215 b( i, j ) = alpha * a( i, j )
216 270 CONTINUE
217 280 CONTINUE
218 ELSE IF( beta.EQ.one ) THEN
219 DO 300 j = 1, n
220 DO 290 i = j, m
221 b( i, j ) = alpha * a( i, j ) + b( i, j )
222 290 CONTINUE
223 300 CONTINUE
224 ELSE
225 DO 320 j = 1, n
226 DO 310 i = j, m
227 b( i, j ) = alpha * a( i, j ) + beta * b( i, j )
228 310 CONTINUE
229 320 CONTINUE
230 END IF
231 END IF
232*
233* If MODE = 'Transpose'
234*
235 ELSE IF( lsame( mode, 'T' ) ) THEN
236 IF( alpha.EQ.zero ) THEN
237 IF( beta.EQ.zero ) THEN
238 DO 340 j = 1, n
239 DO 330 i = 1, m
240 b( i, j ) = zero
241 330 CONTINUE
242 340 CONTINUE
243 ELSE
244 DO 360 j = 1, n
245 DO 350 i = 1, m
246 b( i, j ) = beta * b( i, j )
247 350 CONTINUE
248 360 CONTINUE
249 END IF
250*
251 ELSE IF( alpha.EQ.one ) THEN
252 IF( beta.EQ.zero ) THEN
253 DO 380 j = 1, n
254 DO 370 i = 1, m
255 b( i, j ) = a( j, i )
256 370 CONTINUE
257 380 CONTINUE
258 ELSE IF( beta.EQ.one ) THEN
259 DO 400 j = 1, n
260 DO 390 i = 1, m
261 b( i, j ) = a( j, i ) + b( i, j )
262 390 CONTINUE
263 400 CONTINUE
264 ELSE
265 DO 420 j = 1, n
266 DO 410 i = 1, m
267 b( i, j ) = a( j, i ) + beta * b( i, j )
268 410 CONTINUE
269 420 CONTINUE
270 END IF
271*
272 ELSE
273 IF( beta.EQ.zero ) THEN
274 DO 440 j = 1, n
275 DO 430 i = 1, m
276 b( i, j ) = alpha * a( j, i )
277 430 CONTINUE
278 440 CONTINUE
279 ELSE IF( beta.EQ.one ) THEN
280 DO 460 j = 1, n
281 DO 450 i = 1, m
282 b( i, j ) = alpha * a( j, i ) + b( i, j )
283 450 CONTINUE
284 460 CONTINUE
285 ELSE
286 DO 480 j = 1, n
287 DO 470 i = 1, m
288 b( i, j ) = alpha * a( j, i ) + beta * b( i, j )
289 470 CONTINUE
290 480 CONTINUE
291 END IF
292 END IF
293*
294* If MODE = 'Conjugate',
295*
296 ELSE IF( lsame( mode, 'C' ) ) THEN
297 IF( alpha.EQ.zero ) THEN
298 IF( beta.EQ.zero ) THEN
299 DO 500 j = 1, n
300 DO 490 i = 1, m
301 b( i, j ) = zero
302 490 CONTINUE
303 500 CONTINUE
304 ELSE
305 DO 520 j = 1, n
306 DO 510 i = 1, m
307 b( i, j ) = beta * b( i, j )
308 510 CONTINUE
309 520 CONTINUE
310 END IF
311*
312 ELSE IF( alpha.EQ.one ) THEN
313 IF( beta.EQ.zero ) THEN
314 DO 540 j = 1, n
315 DO 530 i = 1, m
316 b( i, j ) = dconjg( a( j, i ) )
317 530 CONTINUE
318 540 CONTINUE
319 ELSE IF( beta.EQ.one ) THEN
320 DO 560 j = 1, n
321 DO 550 i = 1, m
322 b( i, j ) = dconjg( a( j, i ) ) + b( i, j )
323 550 CONTINUE
324 560 CONTINUE
325 ELSE
326 DO 580 j = 1, n
327 DO 570 i = 1, m
328 b( i, j ) = dconjg( a( j, i ) ) + beta * b( i, j )
329 570 CONTINUE
330 580 CONTINUE
331 END IF
332*
333 ELSE
334 IF( beta.EQ.zero ) THEN
335 DO 600 j = 1, n
336 DO 590 i = 1, m
337 b( i, j ) = alpha * dconjg( a( j, i ) )
338 590 CONTINUE
339 600 CONTINUE
340 ELSE IF( beta.EQ.one ) THEN
341 DO 620 j = 1, n
342 DO 610 i = 1, m
343 b( i, j ) = alpha * dconjg( a( j, i ) ) + b( i, j )
344 610 CONTINUE
345 620 CONTINUE
346 ELSE
347 DO 640 j = 1, n
348 DO 630 i = 1, m
349 b( i, j ) = alpha * dconjg( a( j, i ) )
350 $ + beta * b( i, j )
351 630 CONTINUE
352 640 CONTINUE
353 END IF
354 END IF
355*
356* Other cases (for genral matrix additions)
357*
358 ELSE
359 IF( alpha.EQ.zero ) THEN
360 IF( beta.EQ.zero ) THEN
361 DO 660 j = 1, n
362 DO 650 i = 1, m
363 b( i, j ) = zero
364 650 CONTINUE
365 660 CONTINUE
366*
367 ELSE
368 IF( m.EQ.ldb ) THEN
369 CALL zscal( m*n, beta, b( 1, 1 ), 1 )
370 ELSE IF( lsame( mode, 'V' ) ) THEN
371 DO 670 j = 1, n
372 CALL zscal( m, beta, b( 1, j ), 1 )
373 670 CONTINUE
374 ELSE
375 DO 690 j = 1, n
376 DO 680 i = 1, m
377 b( i, j ) = beta * b( i, j )
378 680 CONTINUE
379 690 CONTINUE
380 END IF
381 END IF
382*
383 ELSE IF( alpha.EQ.one ) THEN
384 IF( beta.EQ.zero ) THEN
385 IF( m.EQ.lda .AND. m.EQ.ldb ) THEN
386 CALL zcopy( m*n, a( 1, 1 ), 1, b( 1, 1 ), 1 )
387 ELSE IF( lsame( mode, 'V' ) ) THEN
388 DO 700 j = 1, n
389 CALL zcopy( m, a( 1, j ), 1, b( 1, j ), 1 )
390 700 CONTINUE
391 ELSE
392 DO 720 j = 1, n
393 DO 710 i = 1, m
394 b( i, j ) = a( i, j )
395 710 CONTINUE
396 720 CONTINUE
397 END IF
398*
399 ELSE IF( beta.EQ.one ) THEN
400 DO 740 j = 1, n
401 DO 730 i = 1, m
402 b( i, j ) = a( i, j ) + b( i, j )
403 730 CONTINUE
404 740 CONTINUE
405*
406 ELSE
407 DO 760 j = 1, n
408 DO 750 i = 1, m
409 b( i, j ) = a( i, j ) + beta * b( i, j )
410 750 CONTINUE
411 760 CONTINUE
412 END IF
413*
414 ELSE
415 IF( beta.EQ.zero ) THEN
416 DO 780 j = 1, n
417 DO 770 i = 1, m
418 b( i, j ) = alpha * a( i, j )
419 770 CONTINUE
420 780 CONTINUE
421*
422 ELSE IF( beta.EQ.one ) THEN
423 IF( m.EQ.lda .AND. m.EQ.ldb ) THEN
424 CALL zaxpy( m*n, alpha, a( 1, 1 ), 1, b( 1, 1 ), 1 )
425 ELSE IF( lsame( mode, 'V' ) ) THEN
426 DO 790 j = 1, n
427 CALL zaxpy( m, alpha, a( 1, j ), 1, b( 1, j ), 1 )
428 790 CONTINUE
429 ELSE
430 DO 810 j = 1, n
431 DO 800 i = 1, m
432 b( i, j ) = alpha * a( i, j ) + b( i, j )
433 800 CONTINUE
434 810 CONTINUE
435 END IF
436*
437 ELSE
438 DO 830 j = 1, n
439 DO 820 i = 1, m
440 b( i, j ) = alpha * a( i, j ) + beta * b( i, j )
441 820 CONTINUE
442 830 CONTINUE
443 END IF
444 END IF
445 END IF
446*
447 RETURN
448*
449* End of PBZMATADD
450*
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
min
#define min(a, b)
Definition macros.h:20