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

Go to the source code of this file.

Functions/Subroutines

subroutine dmmtadd (m, n, alpha, a, lda, beta, b, ldb)

Function/Subroutine Documentation

◆ dmmtadd()

subroutine dmmtadd ( integer m,
integer n,
double precision alpha,
double precision, dimension( lda, * ) a,
integer lda,
double precision beta,
double precision, dimension( ldb, * ) b,
integer ldb )

Definition at line 1 of file dmmtadd.f.

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* DMMTADD 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 DMMTADD
205*
alpha
#define alpha
Definition eval.h:35
dscal
subroutine dscal(n, da, dx, incx)
DSCAL
Definition dscal.f:79
daxpy
subroutine daxpy(n, da, dx, incx, dy, incy)
DAXPY
Definition daxpy.f:89
dcopy
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82