2
3
4
5
6
7
8
9 INTEGER LDA, LDB, M, N
10 COMPLEX ALPHA, BETA
11
12
13 COMPLEX 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 COMPLEX ONE, ZERO
69 parameter( one = ( 1.0e+0, 0.0e+0 ),
70 $ zero = ( 0.0e+0, 0.0e+0 ) )
71
72
73 INTEGER I, J
74
75
77
78
79
80 IF(
alpha.EQ.one )
THEN
81 IF( beta.EQ.zero ) THEN
82 DO 20 j = 1, n
83 CALL ccopy( m, a( 1, j ), 1, b( 1, j ), 1 )
84
85
86
87 20 CONTINUE
88 ELSE IF( beta.NE.one ) THEN
89 DO 40 j = 1, n
90 DO 30 i = 1, m
91 b( i, j ) = a( i, j ) + beta * b( i, j )
92 30 CONTINUE
93 40 CONTINUE
94 ELSE
95 DO 60 j = 1, n
96 CALL caxpy( m, one, a( 1, j ), 1, b( 1, j ), 1 )
97
98
99
100 60 CONTINUE
101 END IF
102 ELSE IF(
alpha.NE.zero )
THEN
103 IF( beta.EQ.zero ) THEN
104 DO 80 j = 1, n
105 DO 70 i = 1, m
106 b( i, j ) =
alpha * a( i, j )
107 70 CONTINUE
108 80 CONTINUE
109 ELSE IF( beta.NE.one ) THEN
110 DO 100 j = 1, n
111 DO 90 i = 1, m
112 b( i, j ) =
alpha * a( i, j ) + beta * b( i, j )
113 90 CONTINUE
114 100 CONTINUE
115 ELSE
116 DO 120 j = 1, n
117 CALL caxpy( m,
alpha, a( 1, j ), 1, b( 1, j ), 1 )
118
119
120
121 120 CONTINUE
122 END IF
123 ELSE
124 IF( beta.EQ.zero ) THEN
125 DO 140 j = 1, n
126 DO 130 i = 1, m
127 b( i, j ) = zero
128 130 CONTINUE
129 140 CONTINUE
130 ELSE IF( beta.NE.one ) THEN
131 DO 160 j = 1, n
132 CALL cscal( m, beta, b( 1, j ), 1 )
133
134
135
136 160 CONTINUE
137 END IF
138 END IF
139
140 RETURN
141
142
143
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
subroutine cscal(n, ca, cx, incx)
CSCAL