SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
smmddat.f
Go to the documentation of this file.
1 SUBROUTINE smmddat( 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 REAL ALPHA, BETA
11* ..
12* .. Array Arguments ..
13 REAL A( LDA, * ), B( LDB, * )
14* ..
15*
16* Purpose
17* =======
18*
19* SMMDDAT 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) REAL
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) REAL 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) REAL
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) REAL 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 REAL ONE, ZERO
70 parameter( one = 1.0e+0, zero = 0.0e+0 )
71* ..
72* .. Local Scalars ..
73 INTEGER I, J
74* ..
75* .. External Subroutines ..
76 EXTERNAL saxpy, scopy, sscal
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 scopy( 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 saxpy( 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 saxpy( 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 sscal( 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 scopy( 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 saxpy( 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 saxpy( 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 sscal( 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 SMMDDAT
205*
206 END
subroutine smmddat(m, n, alpha, a, lda, beta, b, ldb)
Definition smmddat.f:2