ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
dmmddat.f
Go to the documentation of this file.
1  SUBROUTINE dmmddat( 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 * DMMDDAT performs the following operation:
20 *
21 * A := 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/local output) DOUBLE PRECISION array
43 * On entry, A is an array of dimension ( LDA, N ). On exit, the
44 * leading n by m part of B has been added to the leading m by n
45 * part of A.
46 *
47 * LDA (local input) INTEGER
48 * On entry, LDA specifies the leading dimension of the array A.
49 * LDA must be at least max( 1, M ).
50 *
51 * BETA (local input) DOUBLE PRECISION
52 * On entry, BETA specifies the scalar beta. When BETA is sup-
53 * plied as zero then the local entries of the array B need not
54 * be set on input.
55 *
56 * B (local input) DOUBLE PRECISION array
57 * On entry, B is an array of dimension ( LDB, M ).
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( beta.EQ.one ) THEN
82  IF( alpha.EQ.zero ) THEN
83  DO 20 j = 1, n
84  CALL dcopy( m, b( j, 1 ), ldb, a( 1, j ), 1 )
85 * DO 10 I = 1, M
86 * A( I, J ) = B( J, I )
87 * 10 CONTINUE
88  20 CONTINUE
89  ELSE IF( alpha.NE.one ) THEN
90  DO 40 j = 1, n
91  DO 30 i = 1, m
92  a( i, j ) = b( j, i ) + alpha * a( i, j )
93  30 CONTINUE
94  40 CONTINUE
95  ELSE
96  DO 60 j = 1, n
97  CALL daxpy( m, one, b( j, 1 ), ldb, a( 1, j ), 1 )
98 * DO 50 I = 1, M
99 * A( I, J ) = B( J, I ) + A( I, J )
100 * 50 CONTINUE
101  60 CONTINUE
102  END IF
103  ELSE IF( beta.NE.zero ) THEN
104  IF( alpha.EQ.zero ) THEN
105  DO 80 j = 1, n
106  DO 70 i = 1, m
107  a( i, j ) = beta * b( j, i )
108  70 CONTINUE
109  80 CONTINUE
110  ELSE IF( alpha.NE.one ) THEN
111  DO 100 j = 1, n
112  DO 90 i = 1, m
113  a( i, j ) = beta * b( j, i ) + alpha * a( i, j )
114  90 CONTINUE
115  100 CONTINUE
116  ELSE
117  DO 120 j = 1, n
118  CALL daxpy( m, beta, b( j, 1 ), ldb, a( 1, j ), 1 )
119 * DO 110 I = 1, M
120 * A( I, J ) = BETA * B( J, I ) + A( I, J )
121 * 110 CONTINUE
122  120 CONTINUE
123  END IF
124  ELSE
125  IF( alpha.EQ.zero ) THEN
126  DO 140 j = 1, n
127  DO 130 i = 1, m
128  a( i, j ) = zero
129  130 CONTINUE
130  140 CONTINUE
131  ELSE IF( alpha.NE.one ) THEN
132  DO 160 j = 1, n
133  CALL dscal( m, alpha, a( 1, j ), 1 )
134 * DO 150 I = 1, M
135 * A( I, J ) = ALPHA * A( I, J )
136 * 150 CONTINUE
137  160 CONTINUE
138  END IF
139  END IF
140  ELSE
141  IF( beta.EQ.one ) THEN
142  IF( alpha.EQ.zero ) THEN
143  DO 180 j = 1, m
144  CALL dcopy( n, b( 1, j ), 1, a( j, 1 ), lda )
145 * DO 170 I = 1, N
146 * A( J, I ) = B( I, J )
147 * 170 CONTINUE
148  180 CONTINUE
149  ELSE IF( alpha.NE.one ) THEN
150  DO 200 j = 1, m
151  DO 190 i = 1, n
152  a( j, i ) = b( i, j ) + alpha * a( j, i )
153  190 CONTINUE
154  200 CONTINUE
155  ELSE
156  DO 220 j = 1, m
157  CALL daxpy( n, one, b( 1, j ), 1, a( j, 1 ), lda )
158 * DO 210 I = 1, N
159 * A( J, I ) = B( I, J ) + A( J, I )
160 * 210 CONTINUE
161  220 CONTINUE
162  END IF
163  ELSE IF( beta.NE.zero ) THEN
164  IF( alpha.EQ.zero ) THEN
165  DO 240 j = 1, m
166  DO 230 i = 1, n
167  a( j, i ) = beta * b( i, j )
168  230 CONTINUE
169  240 CONTINUE
170  ELSE IF( alpha.NE.one ) THEN
171  DO 260 j = 1, m
172  DO 250 i = 1, n
173  a( j, i ) = beta * b( i, j ) + alpha * a( j, i )
174  250 CONTINUE
175  260 CONTINUE
176  ELSE
177  DO 280 j = 1, m
178  CALL daxpy( n, beta, b( 1, j ), 1, a( j, 1 ), lda )
179 * DO 270 I = 1, N
180 * A( J, I ) = BETA * B( I, J ) + A( J, I )
181 * 270 CONTINUE
182  280 CONTINUE
183  END IF
184  ELSE
185  IF( alpha.EQ.zero ) THEN
186  DO 300 j = 1, n
187  DO 290 i = 1, m
188  a( i, j ) = zero
189  290 CONTINUE
190  300 CONTINUE
191  ELSE IF( alpha.NE.one ) THEN
192  DO 320 j = 1, n
193  CALL dscal( m, alpha, a( 1, j ), 1 )
194 * DO 310 I = 1, M
195 * A( I, J ) = ALPHA * A( I, J )
196 * 310 CONTINUE
197  320 CONTINUE
198  END IF
199  END IF
200  END IF
201 *
202  RETURN
203 *
204 * End of DMMDDAT
205 *
206  END
dmmddat
subroutine dmmddat(M, N, ALPHA, A, LDA, BETA, B, LDB)
Definition: dmmddat.f:2