2
3
4
5
6
7
8
9 CHARACTER*1 UPLO
10 INTEGER IOFFD, LDA, M, N
11 DOUBLE PRECISION ALPHA
12
13
14 DOUBLE PRECISION ( LDA, * )
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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106 DOUBLE PRECISION ONE, ZERO
107 parameter( one = 1.0d+0, zero = 0.0d+0 )
108
109
110 INTEGER J, JTMP, MN
111
112
114
115
116 LOGICAL LSAME
118
119
121
122
123
124
125
126 IF( ( m.LE.0 ).OR.( n.LE.0 ).OR.(
alpha.EQ.one ) )
127 $ RETURN
128
129
130
131 IF(
alpha.EQ.zero )
THEN
132 CALL dtzpad( uplo,
'N', m, n, ioffd, zero, zero, a, lda
133 RETURN
134 END IF
135
136 IF(
lsame( uplo,
'L' ) )
THEN
137
138
139
140 mn =
max( 0, -ioffd )
141 DO 10 j = 1,
min( mn, n )
143 10 CONTINUE
144 DO 20 j = mn + 1,
min( m - ioffd, n )
145 jtmp = j + ioffd
146 IF( m.GE.jtmp )
147 $
CALL dscal( m-jtmp+1,
alpha, a( jtmp, j ), 1 )
148 20 CONTINUE
149
150 ELSE IF(
lsame( uplo,
'U' ) )
THEN
151
152
153
154 mn =
min( m - ioffd, n )
155 DO 30 j =
max( 0, -ioffd ) + 1, mn
157 30 CONTINUE
158 DO 40 j =
max( 0, mn ) + 1, n
160 40 CONTINUE
161
162 ELSE IF(
lsame( uplo,
'D' ) )
THEN
163
164
165
166 DO 50 j =
max( 0, -ioffd ) + 1,
min( m - ioffd, n )
167 jtmp = j + ioffd
168 a( jtmp, j ) =
alpha * a( jtmp, j )
169 50 CONTINUE
170
171 ELSE
172
173
174
175 DO 60 j = 1, n
177 60 CONTINUE
178
179 END IF
180
181 RETURN
182
183
184
subroutine dtzpad(uplo, herm, m, n, ioffd, alpha, beta, a, lda)
logical function lsame(ca, cb)
LSAME
subroutine dscal(n, da, dx, incx)
DSCAL