122
123
124
125
126
127
128 CHARACTER*1 UPLO
129 INTEGER N, INFO, LDA, LDAF
130
131
132 INTEGER IPIV( * )
133 DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * )
134
135
136
137
138
139 INTEGER NCOLS, I, J, K, KP
140 DOUBLE PRECISION AMAX, UMAX, RPVGRW, TMP
141 LOGICAL UPPER
142
143
144 INTRINSIC abs, max, min
145
146
148 LOGICAL LSAME
149
150
151
152 upper =
lsame(
'Upper', uplo )
153 IF ( info.EQ.0 ) THEN
154 IF ( upper ) THEN
155 ncols = 1
156 ELSE
157 ncols = n
158 END IF
159 ELSE
160 ncols = info
161 END IF
162
163 rpvgrw = 1.0d+0
164 DO i = 1, 2*n
165 work( i ) = 0.0d+0
166 END DO
167
168
169
170
171
172 IF ( upper ) THEN
173 DO j = 1, n
174 DO i = 1, j
175 work( n+i ) = max( abs( a( i, j ) ), work( n+i ) )
176 work( n+j ) = max( abs( a( i, j ) ), work( n+j ) )
177 END DO
178 END DO
179 ELSE
180 DO j = 1, n
181 DO i = j, n
182 work( n+i ) = max( abs( a( i, j ) ), work( n+i ) )
183 work( n+j ) = max( abs( a( i, j ) ), work( n+j ) )
184 END DO
185 END DO
186 END IF
187
188
189
190
191
192
193
194
195 IF ( upper ) THEN
196 k = n
197 DO WHILE ( k .LT. ncols .AND. k.GT.0 )
198 IF ( ipiv( k ).GT.0 ) THEN
199
200 kp = ipiv( k )
201 IF ( kp .NE. k ) THEN
202 tmp = work( n+k )
203 work( n+k ) = work( n+kp )
204 work( n+kp ) = tmp
205 END IF
206 DO i = 1, k
207 work( k ) = max( abs( af( i, k ) ), work( k ) )
208 END DO
209 k = k - 1
210 ELSE
211
212 kp = -ipiv( k )
213 tmp = work( n+k-1 )
214 work( n+k-1 ) = work( n+kp )
215 work( n+kp ) = tmp
216 DO i = 1, k-1
217 work( k ) = max( abs( af( i, k ) ), work( k ) )
218 work( k-1 ) = max( abs( af( i, k-1 ) ), work( k-1 ) )
219 END DO
220 work( k ) = max( abs( af( k, k ) ), work( k ) )
221 k = k - 2
222 END IF
223 END DO
224 k = ncols
225 DO WHILE ( k .LE. n )
226 IF ( ipiv( k ).GT.0 ) THEN
227 kp = ipiv( k )
228 IF ( kp .NE. k ) THEN
229 tmp = work( n+k )
230 work( n+k ) = work( n+kp )
231 work( n+kp ) = tmp
232 END IF
233 k = k + 1
234 ELSE
235 kp = -ipiv( k )
236 tmp = work( n+k )
237 work( n+k ) = work( n+kp )
238 work( n+kp ) = tmp
239 k = k + 2
240 END IF
241 END DO
242 ELSE
243 k = 1
244 DO WHILE ( k .LE. ncols )
245 IF ( ipiv( k ).GT.0 ) THEN
246
247 kp = ipiv( k )
248 IF ( kp .NE. k ) THEN
249 tmp = work( n+k )
250 work( n+k ) = work( n+kp )
251 work( n+kp ) = tmp
252 END IF
253 DO i = k, n
254 work( k ) = max( abs( af( i, k ) ), work( k ) )
255 END DO
256 k = k + 1
257 ELSE
258
259 kp = -ipiv( k )
260 tmp = work( n+k+1 )
261 work( n+k+1 ) = work( n+kp )
262 work( n+kp ) = tmp
263 DO i = k+1, n
264 work( k ) = max( abs( af( i, k ) ), work( k ) )
265 work( k+1 ) = max( abs( af(i, k+1 ) ), work( k+1 ) )
266 END DO
267 work( k ) = max( abs( af( k, k ) ), work( k ) )
268 k = k + 2
269 END IF
270 END DO
271 k = ncols
272 DO WHILE ( k .GE. 1 )
273 IF ( ipiv( k ).GT.0 ) THEN
274 kp = ipiv( k )
275 IF ( kp .NE. k ) THEN
276 tmp = work( n+k )
277 work( n+k ) = work( n+kp )
278 work( n+kp ) = tmp
279 END IF
280 k = k - 1
281 ELSE
282 kp = -ipiv( k )
283 tmp = work( n+k )
284 work( n+k ) = work( n+kp )
285 work( n+kp ) = tmp
286 k = k - 2
287 ENDIF
288 END DO
289 END IF
290
291
292
293
294
295
296
297
298 IF ( upper ) THEN
299 DO i = ncols, n
300 umax = work( i )
301 amax = work( n+i )
302 IF ( umax /= 0.0d+0 ) THEN
303 rpvgrw = min( amax / umax, rpvgrw )
304 END IF
305 END DO
306 ELSE
307 DO i = 1, ncols
308 umax = work( i )
309 amax = work( n+i )
310 IF ( umax /= 0.0d+0 ) THEN
311 rpvgrw = min( amax / umax, rpvgrw )
312 END IF
313 END DO
314 END IF
315
317
318
319
double precision function dla_syrpvgrw(uplo, n, info, a, lda, af, ldaf, ipiv, work)
DLA_SYRPVGRW computes the reciprocal pivot growth factor norm(A)/norm(U) for a symmetric indefinite m...
logical function lsame(ca, cb)
LSAME