ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
dmmtcadd.f
Go to the documentation of this file.
1  SUBROUTINE dmmtcadd( M, N, ALPHA, A, LDA, BETA, B, LDB )
2 *
3 * -- PBLAS auxiliary routine (version 2.0) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * April 1, 1998
7 *
8 * .. Scalar Arguments ..
9  INTEGER LDA, LDB, M, N
10  DOUBLE PRECISION ALPHA, BETA
11 * ..
12 * .. Array Arguments ..
13  DOUBLE PRECISION A( LDA, * ), B( LDB, * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * DMMTCADD performs the following operation:
20 *
21 * B := alpha * A' + beta * B,
22 *
23 * where alpha, beta are scalars; A is an m by n matrix and B is an n by
24 * m matrix.
25 *
26 * Arguments
27 * =========
28 *
29 * M (local input) INTEGER
30 * On entry, M specifies the number of rows of A and the number
31 * of columns of B. M must be at least zero.
32 *
33 * N (local input) INTEGER
34 * On entry, N specifies the number of rows of B and the number
35 * of columns of A. N must be at least zero.
36 *
37 * ALPHA (local input) DOUBLE PRECISION
38 * On entry, ALPHA specifies the scalar alpha. When ALPHA is
39 * supplied as zero then the local entries of the array A need
40 * not be set on input.
41 *
42 * A (local input) DOUBLE PRECISION array
43 * On entry, A is an array of dimension ( LDA, N ).
44 *
45 * LDA (local input) INTEGER
46 * On entry, LDA specifies the leading dimension of the array A.
47 * LDA must be at least max( 1, M ).
48 *
49 * BETA (local input) DOUBLE PRECISION
50 * On entry, BETA specifies the scalar beta. When BETA is sup-
51 * plied as zero then the local entries of the array B need not
52 * be set on input.
53 *
54 * B (local input/local output) DOUBLE PRECISION array
55 * On entry, B is an array of dimension ( LDB, M ). On exit, the
56 * leading m by n part of A has been added to the leading n by m
57 * part of B.
58 *
59 * LDB (local input) INTEGER
60 * On entry, LDB specifies the leading dimension of the array B.
61 * LDB must be at least max( 1, N ).
62 *
63 * -- Written on April 1, 1998 by
64 * Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69  DOUBLE PRECISION ONE, ZERO
70  parameter( one = 1.0d+0, zero = 0.0d+0 )
71 * ..
72 * .. Local Scalars ..
73  INTEGER I, J
74 * ..
75 * .. External Subroutines ..
76  EXTERNAL daxpy, dcopy, dscal
77 * ..
78 * .. Executable Statements ..
79 *
80  IF( m.GE.n ) THEN
81  IF( alpha.EQ.one ) THEN
82  IF( beta.EQ.zero ) THEN
83  DO 20 j = 1, n
84  CALL dcopy( m, a( 1, j ), 1, b( j, 1 ), ldb )
85 * DO 10 I = 1, M
86 * B( J, I ) = A( I, J )
87 * 10 CONTINUE
88  20 CONTINUE
89  ELSE IF( beta.NE.one ) THEN
90  DO 40 j = 1, n
91  DO 30 i = 1, m
92  b( j, i ) = a( i, j ) + beta * b( j, i )
93  30 CONTINUE
94  40 CONTINUE
95  ELSE
96  DO 60 j = 1, n
97  CALL daxpy( m, one, a( 1, j ), 1, b( j, 1 ), ldb )
98 * DO 50 I = 1, M
99 * B( J, I ) = A( I, J ) + B( J, I )
100 * 50 CONTINUE
101  60 CONTINUE
102  END IF
103  ELSE IF( alpha.NE.zero ) THEN
104  IF( beta.EQ.zero ) THEN
105  DO 80 j = 1, n
106  DO 70 i = 1, m
107  b( j, i ) = alpha * a( i, j )
108  70 CONTINUE
109  80 CONTINUE
110  ELSE IF( beta.NE.one ) THEN
111  DO 100 j = 1, n
112  DO 90 i = 1, m
113  b( j, i ) = alpha * a( i, j ) + beta * b( j, i )
114  90 CONTINUE
115  100 CONTINUE
116  ELSE
117  DO 120 j = 1, n
118  CALL daxpy( m, alpha, a( 1, j ), 1, b( j, 1 ), ldb )
119 * DO 110 I = 1, M
120 * B( J, I ) = ALPHA * A( I, J ) + B( J, I )
121 * 110 CONTINUE
122  120 CONTINUE
123  END IF
124  ELSE
125  IF( beta.EQ.zero ) THEN
126  DO 140 j = 1, m
127  DO 130 i = 1, n
128  b( i, j ) = zero
129  130 CONTINUE
130  140 CONTINUE
131  ELSE IF( beta.NE.one ) THEN
132  DO 160 j = 1, m
133  CALL dscal( n, beta, b( 1, j ), 1 )
134 * DO 150 I = 1, N
135 * B( I, J ) = BETA * B( I, J )
136 * 150 CONTINUE
137  160 CONTINUE
138  END IF
139  END IF
140  ELSE
141  IF( alpha.EQ.one ) THEN
142  IF( beta.EQ.zero ) THEN
143  DO 180 j = 1, m
144  CALL dcopy( n, a( j, 1 ), lda, b( 1, j ), 1 )
145 * DO 170 I = 1, N
146 * B( I, J ) = A( J, I )
147 * 170 CONTINUE
148  180 CONTINUE
149  ELSE IF( beta.NE.one ) THEN
150  DO 200 j = 1, m
151  DO 190 i = 1, n
152  b( i, j ) = a( j, i ) + beta * b( i, j )
153  190 CONTINUE
154  200 CONTINUE
155  ELSE
156  DO 220 j = 1, m
157  CALL daxpy( n, one, a( j, 1 ), lda, b( 1, j ), 1 )
158 * DO 210 I = 1, N
159 * B( I, J ) = A( J, I ) + B( I, J )
160 * 210 CONTINUE
161  220 CONTINUE
162  END IF
163  ELSE IF( alpha.NE.zero ) THEN
164  IF( beta.EQ.zero ) THEN
165  DO 240 j = 1, m
166  DO 230 i = 1, n
167  b( i, j ) = alpha * a( j, i )
168  230 CONTINUE
169  240 CONTINUE
170  ELSE IF( beta.NE.one ) THEN
171  DO 260 j = 1, m
172  DO 250 i = 1, n
173  b( i, j ) = alpha * a( j, i ) + beta * b( i, j )
174  250 CONTINUE
175  260 CONTINUE
176  ELSE
177  DO 280 j = 1, m
178  CALL daxpy( n, alpha, a( j, 1 ), lda, b( 1, j ), 1 )
179 * DO 270 I = 1, N
180 * B( I, J ) = ALPHA * A( J, I ) + B( I, J )
181 * 270 CONTINUE
182  280 CONTINUE
183  END IF
184  ELSE
185  IF( beta.EQ.zero ) THEN
186  DO 300 j = 1, m
187  DO 290 i = 1, n
188  b( i, j ) = zero
189  290 CONTINUE
190  300 CONTINUE
191  ELSE IF( beta.NE.one ) THEN
192  DO 320 j = 1, m
193  CALL dscal( n, beta, b( 1, j ), 1 )
194 * DO 310 I = 1, N
195 * B( I, J ) = BETA * B( I, J )
196 * 310 CONTINUE
197  320 CONTINUE
198  END IF
199  END IF
200  END IF
201 *
202  RETURN
203 *
204 * End of DMMTCADD
205 *
206  END
dmmtcadd
subroutine dmmtcadd(M, N, ALPHA, A, LDA, BETA, B, LDB)
Definition: dmmtcadd.f:2