1DLAQR5(1)           LAPACK auxiliary routine (version 3.1)           DLAQR5(1)
2
3
4

NAME

SYNOPSIS

7       SUBROUTINE DLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, SR, SI,
8                          H, LDH, ILOZ, IHIZ, Z, LDZ, V, LDV, U, LDU, NV,  WV,
9                          LDWV, NH, WH, LDWH )
10
11           INTEGER        IHIZ, ILOZ, KACC22, KBOT, KTOP, LDH, LDU, LDV, LDWH,
12                          LDWV, LDZ, N, NH, NSHFTS, NV
13
14           LOGICAL        WANTT, WANTZ
15
16           DOUBLE         PRECISION H( LDH, * ), SI( * ), SR( * ), U(  LDU,  *
17                          ),  V(  LDV,  *  ), WH( LDWH, * ), WV( LDWV, * ), Z(
18                          LDZ, * )
19
20           DOUBLE         PRECISION ZERO, ONE
21
22           PARAMETER      ( ZERO = 0.0d0, ONE = 1.0d0 )
23
24           DOUBLE         PRECISION ALPHA, BETA, H11, H12, H21,  H22,  REFSUM,
25                          SAFMAX, SAFMIN, SCL, SMLNUM, SWAP, TST1, TST2, ULP
26
27           INTEGER        I, I2, I4, INCOL, J, J2, J4, JBOT, JCOL, JLEN, JROW,
28                          JTOP, K, K1, KDU, KMS,  KNZ,  KRCOL,  KZS,  M,  M22,
29                          MBOT, MEND, MSTART, MTOP, NBMPS, NDCOL, NS, NU
30
31           LOGICAL        ACCUM, BLK22, BMP22
32
33           DOUBLE         PRECISION DLAMCH
34
35           EXTERNAL       DLAMCH
36
37           INTRINSIC      ABS, DBLE, MAX, MIN, MOD
38
39           DOUBLE         PRECISION VT( 3 )
40
41           EXTERNAL       DGEMM, DLABAD, DLACPY, DLAQR1, DLARFG, DLASET, DTRMM
42
43           IF(            NSHFTS.LT.2 ) RETURN
44
45           IF(            KTOP.GE.KBOT ) RETURN
46
47           DO             10 I = 1, NSHFTS - 2, 2
48
49           IF(            SI( I ).NE.-SI( I+1 ) ) THEN
50
51           SWAP           = SR( I )
52
53           SR(            I ) = SR( I+1 )
54
55           SR(            I+1 ) = SR( I+2 )
56
57           SR(            I+2 ) = SWAP
58
59           SWAP           = SI( I )
60
61           SI(            I ) = SI( I+1 )
62
63           SI(            I+1 ) = SI( I+2 )
64
65           SI(            I+2 ) = SWAP
66
67           END            IF
68
69           10             CONTINUE
70
71           NS             = NSHFTS - MOD( NSHFTS, 2 )
72
73           SAFMIN         = DLAMCH( 'SAFE MINIMUM' )
74
75           SAFMAX         = ONE / SAFMIN
76
77           CALL           DLABAD( SAFMIN, SAFMAX )
78
79           ULP            = DLAMCH( 'PRECISION' )
80
81           SMLNUM         = SAFMIN*( DBLE( N ) / ULP )
82
83           ACCUM          = ( KACC22.EQ.1 ) .OR. ( KACC22.EQ.2 )
84
85           BLK22          = ( NS.GT.2 ) .AND. ( KACC22.EQ.2 )
86
87           IF(            KTOP+2.LE.KBOT ) H( KTOP+2, KTOP ) = ZERO
88
89           NBMPS          = NS / 2
90
91           KDU            = 6*NBMPS - 3
92
93           DO             220  INCOL  =  3*(  1-NBMPS  ) + KTOP - 1, KBOT - 2,
94                          3*NBMPS - 2
95
96           NDCOL          = INCOL + KDU
97
98           IF(            ACCUM ) CALL DLASET( 'ALL', KDU, KDU, ZERO, ONE,  U,
99                          LDU )
100
101           DO             150 KRCOL = INCOL, MIN( INCOL+3*NBMPS-3, KBOT-2 )
102
103           MTOP           = MAX( 1, ( ( KTOP-1 )-KRCOL+2 ) / 3+1 )
104
105           MBOT           = MIN( NBMPS, ( KBOT-KRCOL ) / 3 )
106
107           M22            = MBOT + 1
108
109           BMP22          =  ( MBOT.LT.NBMPS ) .AND. ( KRCOL+3*( M22-1 ) ).EQ.
110                          ( KBOT-2 )
111
112           DO             20 M = MTOP, MBOT
113
114           K              = KRCOL + 3*( M-1 )
115
116           IF(            K.EQ.KTOP-1 ) THEN
117
118           CALL           DLAQR1( 3, H( KTOP, KTOP ), LDH, SR(  2*M-1  ),  SI(
119                          2*M-1 ), SR( 2*M ), SI( 2*M ), V( 1, M ) )
120
121           ALPHA          = V( 1, M )
122
123           CALL           DLARFG( 3, ALPHA, V( 2, M ), 1, V( 1, M ) )
124
125           ELSE
126
127           BETA           = H( K+1, K )
128
129           V(             2, M ) = H( K+2, K )
130
131           V(             3, M ) = H( K+3, K )
132
133           CALL           DLARFG( 3, BETA, V( 2, M ), 1, V( 1, M ) )
134
135           IF(            V(  1, M ).NE.ZERO .AND.  ( V( 3, M ).NE.ZERO .OR. (
136                          H( K+3, K+1 ).EQ.ZERO .AND. H( K+3, K+2 ).EQ.ZERO  )
137                          ) ) THEN
138
139           H(             K+1, K ) = BETA
140
141           H(             K+2, K ) = ZERO
142
143           H(             K+3, K ) = ZERO
144
145           ELSE
146
147           CALL           DLAQR1(  3,  H(  K+1,  K+1  ), LDH, SR( 2*M-1 ), SI(
148                          2*M-1 ), SR( 2*M ), SI( 2*M ), VT )
149
150           SCL            = ABS( VT( 1 ) ) + ABS( VT( 2 ) ) + ABS( VT( 3 ) )
151
152           IF(            SCL.NE.ZERO ) THEN
153
154           VT(            1 ) = VT( 1 ) / SCL
155
156           VT(            2 ) = VT( 2 ) / SCL
157
158           VT(            3 ) = VT( 3 ) / SCL
159
160           END            IF
161
162           IF(            ABS( H( K+1, K ) )*( ABS( VT( 2 ) )+ ABS( VT( 3 )  )
163                          ).GT.ULP*ABS(  VT( 1 ) )* ( ABS( H( K, K ) )+ABS( H(
164                          K+1, K+1 ) )+ABS( H( K+2, K+2 ) ) ) ) THEN
165
166           IF(            V( 2, M ).EQ.ZERO .AND. V( 3, M ).EQ.ZERO ) THEN
167
168           V(             1, M ) = ZERO
169
170           ELSE
171
172           H(             K+1, K ) = BETA
173
174           H(             K+2, K ) = ZERO
175
176           H(             K+3, K ) = ZERO
177
178           END            IF
179
180           ELSE
181
182           ALPHA          = VT( 1 )
183
184           CALL           DLARFG( 3, ALPHA, VT( 2 ), 1, VT( 1 ) )
185
186           REFSUM         = H( K+1, K ) + H( K+2, K )*VT( 2  )  +  H(  K+3,  K
187                          )*VT( 3 )
188
189           H(             K+1, K ) = H( K+1, K ) - VT( 1 )*REFSUM
190
191           H(             K+2, K ) = ZERO
192
193           H(             K+3, K ) = ZERO
194
195           V(             1, M ) = VT( 1 )
196
197           V(             2, M ) = VT( 2 )
198
199           V(             3, M ) = VT( 3 )
200
201           END            IF
202
203           END            IF
204
205           END            IF
206
207           20             CONTINUE
208
209           K              = KRCOL + 3*( M22-1 )
210
211           IF(            BMP22 ) THEN
212
213           IF(            K.EQ.KTOP-1 ) THEN
214
215           CALL           DLAQR1(  2,  H(  K+1, K+1 ), LDH, SR( 2*M22-1 ), SI(
216                          2*M22-1 ), SR( 2*M22 ), SI( 2*M22 ), V( 1, M22 ) )
217
218           BETA           = V( 1, M22 )
219
220           CALL           DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
221
222           ELSE
223
224           BETA           = H( K+1, K )
225
226           V(             2, M22 ) = H( K+2, K )
227
228           CALL           DLARFG( 2, BETA, V( 2, M22 ), 1, V( 1, M22 ) )
229
230           H(             K+1, K ) = BETA
231
232           H(             K+2, K ) = ZERO
233
234           END            IF
235
236           ELSE
237
238           V(             1, M22 ) = ZERO
239
240           END            IF
241
242           IF(            ACCUM ) THEN
243
244           JBOT           = MIN( NDCOL, KBOT )
245
246           ELSE           IF( WANTT ) THEN
247
248           JBOT           = N
249
250           ELSE
251
252           JBOT           = KBOT
253
254           END            IF
255
256           DO             40 J = MAX( KTOP, KRCOL ), JBOT
257
258           MEND           = MIN( MBOT, ( J-KRCOL+2 ) / 3 )
259
260           DO             30 M = MTOP, MEND
261
262           K              = KRCOL + 3*( M-1 )
263
264           REFSUM         = V( 1, M )*( H( K+1, J )+V( 2, M )* H( K+2, J  )+V(
265                          3, M )*H( K+3, J ) )
266
267           H(             K+1, J ) = H( K+1, J ) - REFSUM
268
269           H(             K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )
270
271           H(             K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )
272
273           30             CONTINUE
274
275           40             CONTINUE
276
277           IF(            BMP22 ) THEN
278
279           K              = KRCOL + 3*( M22-1 )
280
281           DO             50 J = MAX( K+1, KTOP ), JBOT
282
283           REFSUM         = V( 1, M22 )*( H( K+1, J )+V( 2, M22 )* H( K+2, J )
284                          )
285
286           H(             K+1, J ) = H( K+1, J ) - REFSUM
287
288           H(             K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )
289
290           50             CONTINUE
291
292           END            IF
293
294           IF(            ACCUM ) THEN
295
296           JTOP           = MAX( KTOP, INCOL )
297
298           ELSE           IF( WANTT ) THEN
299
300           JTOP           = 1
301
302           ELSE
303
304           JTOP           = KTOP
305
306           END            IF
307
308           DO             90 M = MTOP, MBOT
309
310           IF(            V( 1, M ).NE.ZERO ) THEN
311
312           K              = KRCOL + 3*( M-1 )
313
314           DO             60 J = JTOP, MIN( KBOT, K+3 )
315
316           REFSUM         = V( 1, M )*( H( J, K+1 )+V( 2, M )* H( J, K+2  )+V(
317                          3, M )*H( J, K+3 ) )
318
319           H(             J, K+1 ) = H( J, K+1 ) - REFSUM
320
321           H(             J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M )
322
323           H(             J, K+3 ) = H( J, K+3 ) - REFSUM*V( 3, M )
324
325           60             CONTINUE
326
327           IF(            ACCUM ) THEN
328
329           KMS            = K - INCOL
330
331           DO             70 J = MAX( 1, KTOP-INCOL ), KDU
332
333           REFSUM         =  V(  1, M )*( U( J, KMS+1 )+V( 2, M )* U( J, KMS+2
334                          )+V( 3, M )*U( J, KMS+3 ) )
335
336           U(             J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
337
338           U(             J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M )
339
340           U(             J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*V( 3, M )
341
342           70             CONTINUE
343
344           ELSE           IF( WANTZ ) THEN
345
346           DO             80 J = ILOZ, IHIZ
347
348           REFSUM         = V( 1, M )*( Z( J, K+1 )+V( 2, M )* Z( J, K+2  )+V(
349                          3, M )*Z( J, K+3 ) )
350
351           Z(             J, K+1 ) = Z( J, K+1 ) - REFSUM
352
353           Z(             J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M )
354
355           Z(             J, K+3 ) = Z( J, K+3 ) - REFSUM*V( 3, M )
356
357           80             CONTINUE
358
359           END            IF
360
361           END            IF
362
363           90             CONTINUE
364
365           K              = KRCOL + 3*( M22-1 )
366
367           IF(            BMP22 .AND. ( V( 1, M22 ).NE.ZERO ) ) THEN
368
369           DO             100 J = JTOP, MIN( KBOT, K+3 )
370
371           REFSUM         = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )* H( J, K+2 )
372                          )
373
374           H(             J, K+1 ) = H( J, K+1 ) - REFSUM
375
376           H(             J, K+2 ) = H( J, K+2 ) - REFSUM*V( 2, M22 )
377
378           100            CONTINUE
379
380           IF(            ACCUM ) THEN
381
382           KMS            = K - INCOL
383
384           DO             110 J = MAX( 1, KTOP-INCOL ), KDU
385
386           REFSUM         = V( 1, M22 )*( U( J, KMS+1 )+V( 2,  M22  )*  U(  J,
387                          KMS+2 ) )
388
389           U(             J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
390
391           U(             J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*V( 2, M22 )
392
393           110            CONTINUE
394
395           ELSE           IF( WANTZ ) THEN
396
397           DO             120 J = ILOZ, IHIZ
398
399           REFSUM         = V( 1, M22 )*( Z( J, K+1 )+V( 2, M22 )* Z( J, K+2 )
400                          )
401
402           Z(             J, K+1 ) = Z( J, K+1 ) - REFSUM
403
404           Z(             J, K+2 ) = Z( J, K+2 ) - REFSUM*V( 2, M22 )
405
406           120            CONTINUE
407
408           END            IF
409
410           END            IF
411
412           MSTART         = MTOP
413
414           IF(            KRCOL+3*( MSTART-1 ).LT.KTOP ) MSTART = MSTART + 1
415
416           MEND           = MBOT
417
418           IF(            BMP22 ) MEND = MEND + 1
419
420           IF(            KRCOL.EQ.KBOT-2 ) MEND = MEND + 1
421
422           DO             130 M = MSTART, MEND
423
424           K              = MIN( KBOT-1, KRCOL+3*( M-1 ) )
425
426           IF(            H( K+1, K ).NE.ZERO ) THEN
427
428           TST1           = ABS( H( K, K ) ) + ABS( H( K+1, K+1 ) )
429
430           IF(            TST1.EQ.ZERO ) THEN
431
432           IF(            K.GE.KTOP+1 ) TST1 = TST1 + ABS( H( K, K-1 ) )
433
434           IF(            K.GE.KTOP+2 ) TST1 = TST1 + ABS( H( K, K-2 ) )
435
436           IF(            K.GE.KTOP+3 ) TST1 = TST1 + ABS( H( K, K-3 ) )
437
438           IF(            K.LE.KBOT-2 ) TST1 = TST1 + ABS( H( K+2, K+1 ) )
439
440           IF(            K.LE.KBOT-3 ) TST1 = TST1 + ABS( H( K+3, K+1 ) )
441
442           IF(            K.LE.KBOT-4 ) TST1 = TST1 + ABS( H( K+4, K+1 ) )
443
444           END            IF
445
446           IF(            ABS( H( K+1, K ) ).LE.MAX( SMLNUM, ULP*TST1 ) ) THEN
447
448           H12            = MAX( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
449
450           H21            = MIN( ABS( H( K+1, K ) ), ABS( H( K, K+1 ) ) )
451
452           H11            = MAX( ABS( H( K+1, K+1 ) ), ABS( H( K, K )-H(  K+1,
453                          K+1 ) ) )
454
455           H22            =  MIN( ABS( H( K+1, K+1 ) ), ABS( H( K, K )-H( K+1,
456                          K+1 ) ) )
457
458           SCL            = H11 + H12
459
460           TST2           = H22*( H11 / SCL )
461
462           IF(            TST2.EQ.ZERO .OR. H21*( H12 / SCL ).LE.   MAX(  SML‐
463                          NUM, ULP*TST2 ) )H( K+1, K ) = ZERO
464
465           END            IF
466
467           END            IF
468
469           130            CONTINUE
470
471           MEND           = MIN( NBMPS, ( KBOT-KRCOL-1 ) / 3 )
472
473           DO             140 M = MTOP, MEND
474
475           K              = KRCOL + 3*( M-1 )
476
477           REFSUM         = V( 1, M )*V( 3, M )*H( K+4, K+3 )
478
479           H(             K+4, K+1 ) = -REFSUM
480
481           H(             K+4, K+2 ) = -REFSUM*V( 2, M )
482
483           H(             K+4, K+3 ) = H( K+4, K+3 ) - REFSUM*V( 3, M )
484
485           140            CONTINUE
486
487           150            CONTINUE
488
489           IF(            ACCUM ) THEN
490
491           IF(            WANTT ) THEN
492
493           JTOP           = 1
494
495           JBOT           = N
496
497           ELSE
498
499           JTOP           = KTOP
500
501           JBOT           = KBOT
502
503           END            IF
504
505           IF(            (  .NOT.BLK22  )  .OR.  (  INCOL.LT.KTOP  )  .OR.  (
506                          NDCOL.GT.KBOT ) .OR. ( NS.LE.2 ) ) THEN
507
508           K1             = MAX( 1, KTOP-INCOL )
509
510           NU             = ( KDU-MAX( 0, NDCOL-KBOT ) ) - K1 + 1
511
512           DO             160 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
513
514           JLEN           = MIN( NH, JBOT-JCOL+1 )
515
516           CALL           DGEMM( 'C', 'N', NU, JLEN, NU, ONE,  U(  K1,  K1  ),
517                          LDU, H( INCOL+K1, JCOL ), LDH, ZERO, WH, LDWH )
518
519           CALL           DLACPY( 'ALL', NU, JLEN, WH, LDWH, H( INCOL+K1, JCOL
520                          ), LDH )
521
522           160            CONTINUE
523
524           DO             170 JROW = JTOP, MAX( KTOP, INCOL ) - 1, NV
525
526           JLEN           = MIN( NV, MAX( KTOP, INCOL )-JROW )
527
528           CALL           DGEMM(  'N',  'N',  JLEN,  NU,  NU,  ONE,  H(  JROW,
529                          INCOL+K1 ), LDH, U( K1, K1 ), LDU, ZERO, WV, LDWV )
530
531           CALL           DLACPY( 'ALL', JLEN, NU, WV, LDWV, H( JROW, INCOL+K1
532                          ), LDH )
533
534           170            CONTINUE
535
536           IF(            WANTZ ) THEN
537
538           DO             180 JROW = ILOZ, IHIZ, NV
539
540           JLEN           = MIN( NV, IHIZ-JROW+1 )
541
542           CALL           DGEMM(  'N',  'N',  JLEN,  NU,  NU,  ONE,  Z(  JROW,
543                          INCOL+K1 ), LDZ, U( K1, K1 ), LDU, ZERO, WV, LDWV )
544
545           CALL           DLACPY( 'ALL', JLEN, NU, WV, LDWV, Z( JROW, INCOL+K1
546                          ), LDZ )
547
548           180            CONTINUE
549
550           END            IF
551
552           ELSE
553
554           I2             = ( KDU+1 ) / 2
555
556           I4             = KDU
557
558           J2             = I4 - I2
559
560           J4             = KDU
561
562           KZS            = ( J4-J2 ) - ( NS+1 )
563
564           KNZ            = NS + 1
565
566           DO             190 JCOL = MIN( NDCOL, KBOT ) + 1, JBOT, NH
567
568           JLEN           = MIN( NH, JBOT-JCOL+1 )
569
570           CALL           DLACPY( 'ALL', KNZ, JLEN,  H(  INCOL+1+J2,  JCOL  ),
571                          LDH, WH( KZS+1, 1 ), LDWH )
572
573           CALL           DLASET( 'ALL', KZS, JLEN, ZERO, ZERO, WH, LDWH )
574
575           CALL           DTRMM(  'L', 'U', 'C', 'N', KNZ, JLEN, ONE, U( J2+1,
576                          1+KZS ), LDU, WH( KZS+1, 1 ), LDWH )
577
578           CALL           DGEMM( 'C', 'N', I2,  JLEN,  J2,  ONE,  U,  LDU,  H(
579                          INCOL+1, JCOL ), LDH, ONE, WH, LDWH )
580
581           CALL           DLACPY(  'ALL',  J2,  JLEN, H( INCOL+1, JCOL ), LDH,
582                          WH( I2+1, 1 ), LDWH )
583
584           CALL           DTRMM( 'L', 'L', 'C', 'N', J2, JLEN, ONE, U( 1, I2+1
585                          ), LDU, WH( I2+1, 1 ), LDWH )
586
587           CALL           DGEMM(  'C',  'N', I4-I2, JLEN, J4-J2, ONE, U( J2+1,
588                          I2+1 ), LDU, H( INCOL+1+J2, JCOL ),  LDH,  ONE,  WH(
589                          I2+1, 1 ), LDWH )
590
591           CALL           DLACPY( 'ALL', KDU, JLEN, WH, LDWH, H( INCOL+1, JCOL
592                          ), LDH )
593
594           190            CONTINUE
595
596           DO             200 JROW = JTOP, MAX( INCOL, KTOP ) - 1, NV
597
598           JLEN           = MIN( NV, MAX( INCOL, KTOP )-JROW )
599
600           CALL           DLACPY( 'ALL', JLEN, KNZ,  H(  JROW,  INCOL+1+J2  ),
601                          LDH, WV( 1, 1+KZS ), LDWV )
602
603           CALL           DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )
604
605           CALL           DTRMM(  'R', 'U', 'N', 'N', JLEN, KNZ, ONE, U( J2+1,
606                          1+KZS ), LDU, WV( 1, 1+KZS ), LDWV )
607
608           CALL           DGEMM( 'N', 'N', JLEN, I2, J2, ONE, H( JROW, INCOL+1
609                          ), LDH, U, LDU, ONE, WV, LDWV )
610
611           CALL           DLACPY(  'ALL',  JLEN,  J2, H( JROW, INCOL+1 ), LDH,
612                          WV( 1, 1+I2 ), LDWV )
613
614           CALL           DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,  U(  1,
615                          I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
616
617           CALL           DGEMM(  'N',  'N', JLEN, I4-I2, J4-J2, ONE, H( JROW,
618                          INCOL+1+J2 ), LDH, U( J2+1, I2+1 ), LDU, ONE, WV( 1,
619                          1+I2 ), LDWV )
620
621           CALL           DLACPY( 'ALL', JLEN, KDU, WV, LDWV, H( JROW, INCOL+1
622                          ), LDH )
623
624           200            CONTINUE
625
626           IF(            WANTZ ) THEN
627
628           DO             210 JROW = ILOZ, IHIZ, NV
629
630           JLEN           = MIN( NV, IHIZ-JROW+1 )
631
632           CALL           DLACPY( 'ALL', JLEN, KNZ,  Z(  JROW,  INCOL+1+J2  ),
633                          LDZ, WV( 1, 1+KZS ), LDWV )
634
635           CALL           DLASET( 'ALL', JLEN, KZS, ZERO, ZERO, WV, LDWV )
636
637           CALL           DTRMM(  'R', 'U', 'N', 'N', JLEN, KNZ, ONE, U( J2+1,
638                          1+KZS ), LDU, WV( 1, 1+KZS ), LDWV )
639
640           CALL           DGEMM( 'N', 'N', JLEN, I2, J2, ONE, Z( JROW, INCOL+1
641                          ), LDZ, U, LDU, ONE, WV, LDWV )
642
643           CALL           DLACPY(  'ALL',  JLEN,  J2, Z( JROW, INCOL+1 ), LDZ,
644                          WV( 1, 1+I2 ), LDWV )
645
646           CALL           DTRMM( 'R', 'L', 'N', 'N', JLEN, I4-I2, ONE,  U(  1,
647                          I2+1 ), LDU, WV( 1, 1+I2 ), LDWV )
648
649           CALL           DGEMM(  'N',  'N', JLEN, I4-I2, J4-J2, ONE, Z( JROW,
650                          INCOL+1+J2 ), LDZ, U( J2+1, I2+1 ), LDU, ONE, WV( 1,
651                          1+I2 ), LDWV )
652
653           CALL           DLACPY( 'ALL', JLEN, KDU, WV, LDWV, Z( JROW, INCOL+1
654                          ), LDZ )
655
656           210            CONTINUE
657
658           END            IF
659
660           END            IF
661
662           END            IF
663
664           220            CONTINUE
665
666           END
667

PURPOSE

669 LAPACK auxiliary routine (versionNo3v.e1m)ber 2006                       DLAQR5(1)