ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pbcmatadd.f
Go to the documentation of this file.
1  SUBROUTINE pbcmatadd( ICONTXT, MODE, M, N, ALPHA, A, LDA, BETA, B,
2  $ LDB )
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 ALPHA, BETA
12 * ..
13 * .. Array Arguments ..
14  COMPLEX A( LDA, * ), B( LDB, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * PBCMATADD 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
63 * ALPHA specifies the scalar alpha.
64 *
65 * A (input) COMPLEX 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
78 * BETA specifies the scalar beta.
79 *
80 * B (input) COMPLEX 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 ZERO, ONE
90  parameter( zero = ( 0.0e+0, 0.0e+0 ),
91  $ one = ( 1.0e+0, 0.0e+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 cscal, ccopy, caxpy
102 * ..
103 * .. Intrinsic Functions ..
104  INTRINSIC min, conjg
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 ) = conjg( 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 ) = conjg( 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 ) = conjg( 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 * conjg( 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 * conjg( 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 * conjg( 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 cscal( m*n, beta, b( 1, 1 ), 1 )
370  ELSE IF( lsame( mode, 'V' ) ) THEN
371  DO 670 j = 1, n
372  CALL cscal( 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 ccopy( 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 ccopy( 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 caxpy( 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 caxpy( 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 PBCMATADD
450 *
451  END
pbcmatadd
subroutine pbcmatadd(ICONTXT, MODE, M, N, ALPHA, A, LDA, BETA, B, LDB)
Definition: pbcmatadd.f:3
min
#define min(A, B)
Definition: pcgemr.c:181