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 A( 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 )
142 CALL dscal( m, alpha, a( 1, j ), 1 )
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
156 CALL dscal( j + ioffd, alpha, a( 1, j ), 1 )
157 30 CONTINUE
158 DO 40 j =
max( 0, mn ) + 1, n
159 CALL dscal( m, alpha, a( 1, j ), 1 )
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
176 CALL dscal( m, alpha, a( 1, j ), 1 )
177 60 CONTINUE
178
179 END IF
180
181 RETURN
182
183
184
subroutine dtzpad(uplo, herm, m, n, ioffd, alpha, beta, a, lda)