Annotation of rpl/lapack/lapack/zlals0.f, revision 1.8
1.8 ! bertrand 1: *> \brief \b ZLALS0
! 2: *
! 3: * =========== DOCUMENTATION ===========
! 4: *
! 5: * Online html documentation available at
! 6: * http://www.netlib.org/lapack/explore-html/
! 7: *
! 8: *> \htmlonly
! 9: *> Download ZLALS0 + dependencies
! 10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlals0.f">
! 11: *> [TGZ]</a>
! 12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlals0.f">
! 13: *> [ZIP]</a>
! 14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlals0.f">
! 15: *> [TXT]</a>
! 16: *> \endhtmlonly
! 17: *
! 18: * Definition:
! 19: * ===========
! 20: *
! 21: * SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX,
! 22: * PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
! 23: * POLES, DIFL, DIFR, Z, K, C, S, RWORK, INFO )
! 24: *
! 25: * .. Scalar Arguments ..
! 26: * INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL,
! 27: * $ LDGNUM, NL, NR, NRHS, SQRE
! 28: * DOUBLE PRECISION C, S
! 29: * ..
! 30: * .. Array Arguments ..
! 31: * INTEGER GIVCOL( LDGCOL, * ), PERM( * )
! 32: * DOUBLE PRECISION DIFL( * ), DIFR( LDGNUM, * ),
! 33: * $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ),
! 34: * $ RWORK( * ), Z( * )
! 35: * COMPLEX*16 B( LDB, * ), BX( LDBX, * )
! 36: * ..
! 37: *
! 38: *
! 39: *> \par Purpose:
! 40: * =============
! 41: *>
! 42: *> \verbatim
! 43: *>
! 44: *> ZLALS0 applies back the multiplying factors of either the left or the
! 45: *> right singular vector matrix of a diagonal matrix appended by a row
! 46: *> to the right hand side matrix B in solving the least squares problem
! 47: *> using the divide-and-conquer SVD approach.
! 48: *>
! 49: *> For the left singular vector matrix, three types of orthogonal
! 50: *> matrices are involved:
! 51: *>
! 52: *> (1L) Givens rotations: the number of such rotations is GIVPTR; the
! 53: *> pairs of columns/rows they were applied to are stored in GIVCOL;
! 54: *> and the C- and S-values of these rotations are stored in GIVNUM.
! 55: *>
! 56: *> (2L) Permutation. The (NL+1)-st row of B is to be moved to the first
! 57: *> row, and for J=2:N, PERM(J)-th row of B is to be moved to the
! 58: *> J-th row.
! 59: *>
! 60: *> (3L) The left singular vector matrix of the remaining matrix.
! 61: *>
! 62: *> For the right singular vector matrix, four types of orthogonal
! 63: *> matrices are involved:
! 64: *>
! 65: *> (1R) The right singular vector matrix of the remaining matrix.
! 66: *>
! 67: *> (2R) If SQRE = 1, one extra Givens rotation to generate the right
! 68: *> null space.
! 69: *>
! 70: *> (3R) The inverse transformation of (2L).
! 71: *>
! 72: *> (4R) The inverse transformation of (1L).
! 73: *> \endverbatim
! 74: *
! 75: * Arguments:
! 76: * ==========
! 77: *
! 78: *> \param[in] ICOMPQ
! 79: *> \verbatim
! 80: *> ICOMPQ is INTEGER
! 81: *> Specifies whether singular vectors are to be computed in
! 82: *> factored form:
! 83: *> = 0: Left singular vector matrix.
! 84: *> = 1: Right singular vector matrix.
! 85: *> \endverbatim
! 86: *>
! 87: *> \param[in] NL
! 88: *> \verbatim
! 89: *> NL is INTEGER
! 90: *> The row dimension of the upper block. NL >= 1.
! 91: *> \endverbatim
! 92: *>
! 93: *> \param[in] NR
! 94: *> \verbatim
! 95: *> NR is INTEGER
! 96: *> The row dimension of the lower block. NR >= 1.
! 97: *> \endverbatim
! 98: *>
! 99: *> \param[in] SQRE
! 100: *> \verbatim
! 101: *> SQRE is INTEGER
! 102: *> = 0: the lower block is an NR-by-NR square matrix.
! 103: *> = 1: the lower block is an NR-by-(NR+1) rectangular matrix.
! 104: *>
! 105: *> The bidiagonal matrix has row dimension N = NL + NR + 1,
! 106: *> and column dimension M = N + SQRE.
! 107: *> \endverbatim
! 108: *>
! 109: *> \param[in] NRHS
! 110: *> \verbatim
! 111: *> NRHS is INTEGER
! 112: *> The number of columns of B and BX. NRHS must be at least 1.
! 113: *> \endverbatim
! 114: *>
! 115: *> \param[in,out] B
! 116: *> \verbatim
! 117: *> B is COMPLEX*16 array, dimension ( LDB, NRHS )
! 118: *> On input, B contains the right hand sides of the least
! 119: *> squares problem in rows 1 through M. On output, B contains
! 120: *> the solution X in rows 1 through N.
! 121: *> \endverbatim
! 122: *>
! 123: *> \param[in] LDB
! 124: *> \verbatim
! 125: *> LDB is INTEGER
! 126: *> The leading dimension of B. LDB must be at least
! 127: *> max(1,MAX( M, N ) ).
! 128: *> \endverbatim
! 129: *>
! 130: *> \param[out] BX
! 131: *> \verbatim
! 132: *> BX is COMPLEX*16 array, dimension ( LDBX, NRHS )
! 133: *> \endverbatim
! 134: *>
! 135: *> \param[in] LDBX
! 136: *> \verbatim
! 137: *> LDBX is INTEGER
! 138: *> The leading dimension of BX.
! 139: *> \endverbatim
! 140: *>
! 141: *> \param[in] PERM
! 142: *> \verbatim
! 143: *> PERM is INTEGER array, dimension ( N )
! 144: *> The permutations (from deflation and sorting) applied
! 145: *> to the two blocks.
! 146: *> \endverbatim
! 147: *>
! 148: *> \param[in] GIVPTR
! 149: *> \verbatim
! 150: *> GIVPTR is INTEGER
! 151: *> The number of Givens rotations which took place in this
! 152: *> subproblem.
! 153: *> \endverbatim
! 154: *>
! 155: *> \param[in] GIVCOL
! 156: *> \verbatim
! 157: *> GIVCOL is INTEGER array, dimension ( LDGCOL, 2 )
! 158: *> Each pair of numbers indicates a pair of rows/columns
! 159: *> involved in a Givens rotation.
! 160: *> \endverbatim
! 161: *>
! 162: *> \param[in] LDGCOL
! 163: *> \verbatim
! 164: *> LDGCOL is INTEGER
! 165: *> The leading dimension of GIVCOL, must be at least N.
! 166: *> \endverbatim
! 167: *>
! 168: *> \param[in] GIVNUM
! 169: *> \verbatim
! 170: *> GIVNUM is DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
! 171: *> Each number indicates the C or S value used in the
! 172: *> corresponding Givens rotation.
! 173: *> \endverbatim
! 174: *>
! 175: *> \param[in] LDGNUM
! 176: *> \verbatim
! 177: *> LDGNUM is INTEGER
! 178: *> The leading dimension of arrays DIFR, POLES and
! 179: *> GIVNUM, must be at least K.
! 180: *> \endverbatim
! 181: *>
! 182: *> \param[in] POLES
! 183: *> \verbatim
! 184: *> POLES is DOUBLE PRECISION array, dimension ( LDGNUM, 2 )
! 185: *> On entry, POLES(1:K, 1) contains the new singular
! 186: *> values obtained from solving the secular equation, and
! 187: *> POLES(1:K, 2) is an array containing the poles in the secular
! 188: *> equation.
! 189: *> \endverbatim
! 190: *>
! 191: *> \param[in] DIFL
! 192: *> \verbatim
! 193: *> DIFL is DOUBLE PRECISION array, dimension ( K ).
! 194: *> On entry, DIFL(I) is the distance between I-th updated
! 195: *> (undeflated) singular value and the I-th (undeflated) old
! 196: *> singular value.
! 197: *> \endverbatim
! 198: *>
! 199: *> \param[in] DIFR
! 200: *> \verbatim
! 201: *> DIFR is DOUBLE PRECISION array, dimension ( LDGNUM, 2 ).
! 202: *> On entry, DIFR(I, 1) contains the distances between I-th
! 203: *> updated (undeflated) singular value and the I+1-th
! 204: *> (undeflated) old singular value. And DIFR(I, 2) is the
! 205: *> normalizing factor for the I-th right singular vector.
! 206: *> \endverbatim
! 207: *>
! 208: *> \param[in] Z
! 209: *> \verbatim
! 210: *> Z is DOUBLE PRECISION array, dimension ( K )
! 211: *> Contain the components of the deflation-adjusted updating row
! 212: *> vector.
! 213: *> \endverbatim
! 214: *>
! 215: *> \param[in] K
! 216: *> \verbatim
! 217: *> K is INTEGER
! 218: *> Contains the dimension of the non-deflated matrix,
! 219: *> This is the order of the related secular equation. 1 <= K <=N.
! 220: *> \endverbatim
! 221: *>
! 222: *> \param[in] C
! 223: *> \verbatim
! 224: *> C is DOUBLE PRECISION
! 225: *> C contains garbage if SQRE =0 and the C-value of a Givens
! 226: *> rotation related to the right null space if SQRE = 1.
! 227: *> \endverbatim
! 228: *>
! 229: *> \param[in] S
! 230: *> \verbatim
! 231: *> S is DOUBLE PRECISION
! 232: *> S contains garbage if SQRE =0 and the S-value of a Givens
! 233: *> rotation related to the right null space if SQRE = 1.
! 234: *> \endverbatim
! 235: *>
! 236: *> \param[out] RWORK
! 237: *> \verbatim
! 238: *> RWORK is DOUBLE PRECISION array, dimension
! 239: *> ( K*(1+NRHS) + 2*NRHS )
! 240: *> \endverbatim
! 241: *>
! 242: *> \param[out] INFO
! 243: *> \verbatim
! 244: *> INFO is INTEGER
! 245: *> = 0: successful exit.
! 246: *> < 0: if INFO = -i, the i-th argument had an illegal value.
! 247: *> \endverbatim
! 248: *
! 249: * Authors:
! 250: * ========
! 251: *
! 252: *> \author Univ. of Tennessee
! 253: *> \author Univ. of California Berkeley
! 254: *> \author Univ. of Colorado Denver
! 255: *> \author NAG Ltd.
! 256: *
! 257: *> \date November 2011
! 258: *
! 259: *> \ingroup complex16OTHERcomputational
! 260: *
! 261: *> \par Contributors:
! 262: * ==================
! 263: *>
! 264: *> Ming Gu and Ren-Cang Li, Computer Science Division, University of
! 265: *> California at Berkeley, USA \n
! 266: *> Osni Marques, LBNL/NERSC, USA \n
! 267: *
! 268: * =====================================================================
1.1 bertrand 269: SUBROUTINE ZLALS0( ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX,
270: $ PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM,
271: $ POLES, DIFL, DIFR, Z, K, C, S, RWORK, INFO )
272: *
1.8 ! bertrand 273: * -- LAPACK computational routine (version 3.4.0) --
1.1 bertrand 274: * -- LAPACK is a software package provided by Univ. of Tennessee, --
275: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.8 ! bertrand 276: * November 2011
1.1 bertrand 277: *
278: * .. Scalar Arguments ..
279: INTEGER GIVPTR, ICOMPQ, INFO, K, LDB, LDBX, LDGCOL,
280: $ LDGNUM, NL, NR, NRHS, SQRE
281: DOUBLE PRECISION C, S
282: * ..
283: * .. Array Arguments ..
284: INTEGER GIVCOL( LDGCOL, * ), PERM( * )
285: DOUBLE PRECISION DIFL( * ), DIFR( LDGNUM, * ),
286: $ GIVNUM( LDGNUM, * ), POLES( LDGNUM, * ),
287: $ RWORK( * ), Z( * )
288: COMPLEX*16 B( LDB, * ), BX( LDBX, * )
289: * ..
290: *
291: * =====================================================================
292: *
293: * .. Parameters ..
294: DOUBLE PRECISION ONE, ZERO, NEGONE
295: PARAMETER ( ONE = 1.0D0, ZERO = 0.0D0, NEGONE = -1.0D0 )
296: * ..
297: * .. Local Scalars ..
298: INTEGER I, J, JCOL, JROW, M, N, NLP1
299: DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, TEMP
300: * ..
301: * .. External Subroutines ..
302: EXTERNAL DGEMV, XERBLA, ZCOPY, ZDROT, ZDSCAL, ZLACPY,
303: $ ZLASCL
304: * ..
305: * .. External Functions ..
306: DOUBLE PRECISION DLAMC3, DNRM2
307: EXTERNAL DLAMC3, DNRM2
308: * ..
309: * .. Intrinsic Functions ..
310: INTRINSIC DBLE, DCMPLX, DIMAG, MAX
311: * ..
312: * .. Executable Statements ..
313: *
314: * Test the input parameters.
315: *
316: INFO = 0
317: *
318: IF( ( ICOMPQ.LT.0 ) .OR. ( ICOMPQ.GT.1 ) ) THEN
319: INFO = -1
320: ELSE IF( NL.LT.1 ) THEN
321: INFO = -2
322: ELSE IF( NR.LT.1 ) THEN
323: INFO = -3
324: ELSE IF( ( SQRE.LT.0 ) .OR. ( SQRE.GT.1 ) ) THEN
325: INFO = -4
326: END IF
327: *
328: N = NL + NR + 1
329: *
330: IF( NRHS.LT.1 ) THEN
331: INFO = -5
332: ELSE IF( LDB.LT.N ) THEN
333: INFO = -7
334: ELSE IF( LDBX.LT.N ) THEN
335: INFO = -9
336: ELSE IF( GIVPTR.LT.0 ) THEN
337: INFO = -11
338: ELSE IF( LDGCOL.LT.N ) THEN
339: INFO = -13
340: ELSE IF( LDGNUM.LT.N ) THEN
341: INFO = -15
342: ELSE IF( K.LT.1 ) THEN
343: INFO = -20
344: END IF
345: IF( INFO.NE.0 ) THEN
346: CALL XERBLA( 'ZLALS0', -INFO )
347: RETURN
348: END IF
349: *
350: M = N + SQRE
351: NLP1 = NL + 1
352: *
353: IF( ICOMPQ.EQ.0 ) THEN
354: *
355: * Apply back orthogonal transformations from the left.
356: *
357: * Step (1L): apply back the Givens rotations performed.
358: *
359: DO 10 I = 1, GIVPTR
360: CALL ZDROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB,
361: $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ),
362: $ GIVNUM( I, 1 ) )
363: 10 CONTINUE
364: *
365: * Step (2L): permute rows of B.
366: *
367: CALL ZCOPY( NRHS, B( NLP1, 1 ), LDB, BX( 1, 1 ), LDBX )
368: DO 20 I = 2, N
369: CALL ZCOPY( NRHS, B( PERM( I ), 1 ), LDB, BX( I, 1 ), LDBX )
370: 20 CONTINUE
371: *
372: * Step (3L): apply the inverse of the left singular vector
373: * matrix to BX.
374: *
375: IF( K.EQ.1 ) THEN
376: CALL ZCOPY( NRHS, BX, LDBX, B, LDB )
377: IF( Z( 1 ).LT.ZERO ) THEN
378: CALL ZDSCAL( NRHS, NEGONE, B, LDB )
379: END IF
380: ELSE
381: DO 100 J = 1, K
382: DIFLJ = DIFL( J )
383: DJ = POLES( J, 1 )
384: DSIGJ = -POLES( J, 2 )
385: IF( J.LT.K ) THEN
386: DIFRJ = -DIFR( J, 1 )
387: DSIGJP = -POLES( J+1, 2 )
388: END IF
389: IF( ( Z( J ).EQ.ZERO ) .OR. ( POLES( J, 2 ).EQ.ZERO ) )
390: $ THEN
391: RWORK( J ) = ZERO
392: ELSE
393: RWORK( J ) = -POLES( J, 2 )*Z( J ) / DIFLJ /
394: $ ( POLES( J, 2 )+DJ )
395: END IF
396: DO 30 I = 1, J - 1
397: IF( ( Z( I ).EQ.ZERO ) .OR.
398: $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN
399: RWORK( I ) = ZERO
400: ELSE
401: RWORK( I ) = POLES( I, 2 )*Z( I ) /
402: $ ( DLAMC3( POLES( I, 2 ), DSIGJ )-
403: $ DIFLJ ) / ( POLES( I, 2 )+DJ )
404: END IF
405: 30 CONTINUE
406: DO 40 I = J + 1, K
407: IF( ( Z( I ).EQ.ZERO ) .OR.
408: $ ( POLES( I, 2 ).EQ.ZERO ) ) THEN
409: RWORK( I ) = ZERO
410: ELSE
411: RWORK( I ) = POLES( I, 2 )*Z( I ) /
412: $ ( DLAMC3( POLES( I, 2 ), DSIGJP )+
413: $ DIFRJ ) / ( POLES( I, 2 )+DJ )
414: END IF
415: 40 CONTINUE
416: RWORK( 1 ) = NEGONE
417: TEMP = DNRM2( K, RWORK, 1 )
418: *
419: * Since B and BX are complex, the following call to DGEMV
420: * is performed in two steps (real and imaginary parts).
421: *
422: * CALL DGEMV( 'T', K, NRHS, ONE, BX, LDBX, WORK, 1, ZERO,
423: * $ B( J, 1 ), LDB )
424: *
425: I = K + NRHS*2
426: DO 60 JCOL = 1, NRHS
427: DO 50 JROW = 1, K
428: I = I + 1
429: RWORK( I ) = DBLE( BX( JROW, JCOL ) )
430: 50 CONTINUE
431: 60 CONTINUE
432: CALL DGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K,
433: $ RWORK( 1 ), 1, ZERO, RWORK( 1+K ), 1 )
434: I = K + NRHS*2
435: DO 80 JCOL = 1, NRHS
436: DO 70 JROW = 1, K
437: I = I + 1
438: RWORK( I ) = DIMAG( BX( JROW, JCOL ) )
439: 70 CONTINUE
440: 80 CONTINUE
441: CALL DGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K,
442: $ RWORK( 1 ), 1, ZERO, RWORK( 1+K+NRHS ), 1 )
443: DO 90 JCOL = 1, NRHS
444: B( J, JCOL ) = DCMPLX( RWORK( JCOL+K ),
445: $ RWORK( JCOL+K+NRHS ) )
446: 90 CONTINUE
447: CALL ZLASCL( 'G', 0, 0, TEMP, ONE, 1, NRHS, B( J, 1 ),
448: $ LDB, INFO )
449: 100 CONTINUE
450: END IF
451: *
452: * Move the deflated rows of BX to B also.
453: *
454: IF( K.LT.MAX( M, N ) )
455: $ CALL ZLACPY( 'A', N-K, NRHS, BX( K+1, 1 ), LDBX,
456: $ B( K+1, 1 ), LDB )
457: ELSE
458: *
459: * Apply back the right orthogonal transformations.
460: *
461: * Step (1R): apply back the new right singular vector matrix
462: * to B.
463: *
464: IF( K.EQ.1 ) THEN
465: CALL ZCOPY( NRHS, B, LDB, BX, LDBX )
466: ELSE
467: DO 180 J = 1, K
468: DSIGJ = POLES( J, 2 )
469: IF( Z( J ).EQ.ZERO ) THEN
470: RWORK( J ) = ZERO
471: ELSE
472: RWORK( J ) = -Z( J ) / DIFL( J ) /
473: $ ( DSIGJ+POLES( J, 1 ) ) / DIFR( J, 2 )
474: END IF
475: DO 110 I = 1, J - 1
476: IF( Z( J ).EQ.ZERO ) THEN
477: RWORK( I ) = ZERO
478: ELSE
479: RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I+1,
480: $ 2 ) )-DIFR( I, 1 ) ) /
481: $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
482: END IF
483: 110 CONTINUE
484: DO 120 I = J + 1, K
485: IF( Z( J ).EQ.ZERO ) THEN
486: RWORK( I ) = ZERO
487: ELSE
488: RWORK( I ) = Z( J ) / ( DLAMC3( DSIGJ, -POLES( I,
489: $ 2 ) )-DIFL( I ) ) /
490: $ ( DSIGJ+POLES( I, 1 ) ) / DIFR( I, 2 )
491: END IF
492: 120 CONTINUE
493: *
494: * Since B and BX are complex, the following call to DGEMV
495: * is performed in two steps (real and imaginary parts).
496: *
497: * CALL DGEMV( 'T', K, NRHS, ONE, B, LDB, WORK, 1, ZERO,
498: * $ BX( J, 1 ), LDBX )
499: *
500: I = K + NRHS*2
501: DO 140 JCOL = 1, NRHS
502: DO 130 JROW = 1, K
503: I = I + 1
504: RWORK( I ) = DBLE( B( JROW, JCOL ) )
505: 130 CONTINUE
506: 140 CONTINUE
507: CALL DGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K,
508: $ RWORK( 1 ), 1, ZERO, RWORK( 1+K ), 1 )
509: I = K + NRHS*2
510: DO 160 JCOL = 1, NRHS
511: DO 150 JROW = 1, K
512: I = I + 1
513: RWORK( I ) = DIMAG( B( JROW, JCOL ) )
514: 150 CONTINUE
515: 160 CONTINUE
516: CALL DGEMV( 'T', K, NRHS, ONE, RWORK( 1+K+NRHS*2 ), K,
517: $ RWORK( 1 ), 1, ZERO, RWORK( 1+K+NRHS ), 1 )
518: DO 170 JCOL = 1, NRHS
519: BX( J, JCOL ) = DCMPLX( RWORK( JCOL+K ),
520: $ RWORK( JCOL+K+NRHS ) )
521: 170 CONTINUE
522: 180 CONTINUE
523: END IF
524: *
525: * Step (2R): if SQRE = 1, apply back the rotation that is
526: * related to the right null space of the subproblem.
527: *
528: IF( SQRE.EQ.1 ) THEN
529: CALL ZCOPY( NRHS, B( M, 1 ), LDB, BX( M, 1 ), LDBX )
530: CALL ZDROT( NRHS, BX( 1, 1 ), LDBX, BX( M, 1 ), LDBX, C, S )
531: END IF
532: IF( K.LT.MAX( M, N ) )
533: $ CALL ZLACPY( 'A', N-K, NRHS, B( K+1, 1 ), LDB, BX( K+1, 1 ),
534: $ LDBX )
535: *
536: * Step (3R): permute rows of B.
537: *
538: CALL ZCOPY( NRHS, BX( 1, 1 ), LDBX, B( NLP1, 1 ), LDB )
539: IF( SQRE.EQ.1 ) THEN
540: CALL ZCOPY( NRHS, BX( M, 1 ), LDBX, B( M, 1 ), LDB )
541: END IF
542: DO 190 I = 2, N
543: CALL ZCOPY( NRHS, BX( I, 1 ), LDBX, B( PERM( I ), 1 ), LDB )
544: 190 CONTINUE
545: *
546: * Step (4R): apply back the Givens rotations performed.
547: *
548: DO 200 I = GIVPTR, 1, -1
549: CALL ZDROT( NRHS, B( GIVCOL( I, 2 ), 1 ), LDB,
550: $ B( GIVCOL( I, 1 ), 1 ), LDB, GIVNUM( I, 2 ),
551: $ -GIVNUM( I, 1 ) )
552: 200 CONTINUE
553: END IF
554: *
555: RETURN
556: *
557: * End of ZLALS0
558: *
559: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlals0.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack