2
3
4
5
6
7
8
9 INTEGER LDA, , M,
10 REAL ALPHA, BETA
11
12
13 REAL A( LDA, * ), B( LDB, * )
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68 REAL ONE, ZERO
69 parameter( one = 1.0e+0, zero = 0.0e+0 )
70
71
72 INTEGER I,
73
74
76
77
78
79 IF(
alpha.EQ.one )
THEN
80 IF( beta.EQ.zero ) THEN
81 DO 20 j = 1, n
82 CALL scopy( m, a( 1, j ), 1, b( 1, j ), 1 )
83
84
85
86 20 CONTINUE
87 ELSE IF( beta.NE.one ) THEN
88 DO 40 j = 1, n
89 DO 30 i = 1, m
90 b( i, j ) = a( i, j ) + beta * b( i, j )
91 30 CONTINUE
92 40 CONTINUE
93 ELSE
94 DO 60 j = 1, n
95 CALL saxpy( m, one, a( 1, j ), 1, b( 1, j ), 1 )
96
97
98
99 60 CONTINUE
100 END IF
101 ELSE IF(
alpha.NE.zero )
THEN
102 IF( beta.EQ.zero ) THEN
103 DO 80 j = 1, n
104 DO 70 i = 1, m
105 b( i, j ) =
alpha * a( i, j )
106 70 CONTINUE
107 80 CONTINUE
108 ELSE IF( beta.NE.one ) THEN
109 DO 100 j = 1, n
110 DO 90 i = 1, m
111 b( i, j ) =
alpha * a( i, j ) + beta * b( i, j )
112 90 CONTINUE
113 100 CONTINUE
114 ELSE
115 DO 120 j = 1, n
116 CALL saxpy( m,
alpha, a( 1, j ), 1, b( 1, j ), 1 )
117
118
119
120 120 CONTINUE
121 END IF
122 ELSE
123 IF( beta.EQ.zero ) THEN
124 DO 140 j = 1, n
125 DO 130 i = 1, m
126 b( i, j ) = zero
127 130 CONTINUE
128 140 CONTINUE
129 ELSE IF( beta.NE.one ) THEN
130 DO 160 j = 1, n
131 CALL sscal( m, beta, b( 1, j ), 1 )
132
133
134
135 160 CONTINUE
136 END IF
137 END IF
138
139 RETURN
140
141
142
subroutine sscal(n, sa, sx, incx)
SSCAL
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine saxpy(n, sa, sx, incx, sy, incy)
SAXPY