File:  [local] / rpl / lapack / lapack / zggsvp3.f
Revision 1.1: download - view: text, annotated - select for diffs - revision graph
Thu Nov 26 11:44:23 2015 UTC (8 years, 6 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_24, HEAD
Mise à jour de Lapack (3.6.0) et du numéro de version du RPL/2.

    1: *> \brief \b ZGGSVP3
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at 
    6: *            http://www.netlib.org/lapack/explore-html/ 
    7: *
    8: *> \htmlonly
    9: *> Download ZGGSVP3 + dependencies 
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zggsvp3.f"> 
   11: *> [TGZ]</a> 
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zggsvp3.f"> 
   13: *> [ZIP]</a> 
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zggsvp3.f"> 
   15: *> [TXT]</a>
   16: *> \endhtmlonly 
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
   22: *                           TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
   23: *                           IWORK, RWORK, TAU, WORK, LWORK, INFO )
   24:    25: *       .. Scalar Arguments ..
   26: *       CHARACTER          JOBQ, JOBU, JOBV
   27: *       INTEGER            INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P, LWORK
   28: *       DOUBLE PRECISION   TOLA, TOLB
   29: *       ..
   30: *       .. Array Arguments ..
   31: *       INTEGER            IWORK( * )
   32: *       DOUBLE PRECISION   RWORK( * )
   33: *       COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
   34: *      $                   TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
   35: *       ..
   36: *  
   37: *
   38: *> \par Purpose:
   39: *  =============
   40: *>
   41: *> \verbatim
   42: *>
   43: *> ZGGSVP3 computes unitary matrices U, V and Q such that
   44: *>
   45: *>                    N-K-L  K    L
   46: *>  U**H*A*Q =     K ( 0    A12  A13 )  if M-K-L >= 0;
   47: *>                 L ( 0     0   A23 )
   48: *>             M-K-L ( 0     0    0  )
   49: *>
   50: *>                  N-K-L  K    L
   51: *>         =     K ( 0    A12  A13 )  if M-K-L < 0;
   52: *>             M-K ( 0     0   A23 )
   53: *>
   54: *>                  N-K-L  K    L
   55: *>  V**H*B*Q =   L ( 0     0   B13 )
   56: *>             P-L ( 0     0    0  )
   57: *>
   58: *> where the K-by-K matrix A12 and L-by-L matrix B13 are nonsingular
   59: *> upper triangular; A23 is L-by-L upper triangular if M-K-L >= 0,
   60: *> otherwise A23 is (M-K)-by-L upper trapezoidal.  K+L = the effective
   61: *> numerical rank of the (M+P)-by-N matrix (A**H,B**H)**H. 
   62: *>
   63: *> This decomposition is the preprocessing step for computing the
   64: *> Generalized Singular Value Decomposition (GSVD), see subroutine
   65: *> ZGGSVD3.
   66: *> \endverbatim
   67: *
   68: *  Arguments:
   69: *  ==========
   70: *
   71: *> \param[in] JOBU
   72: *> \verbatim
   73: *>          JOBU is CHARACTER*1
   74: *>          = 'U':  Unitary matrix U is computed;
   75: *>          = 'N':  U is not computed.
   76: *> \endverbatim
   77: *>
   78: *> \param[in] JOBV
   79: *> \verbatim
   80: *>          JOBV is CHARACTER*1
   81: *>          = 'V':  Unitary matrix V is computed;
   82: *>          = 'N':  V is not computed.
   83: *> \endverbatim
   84: *>
   85: *> \param[in] JOBQ
   86: *> \verbatim
   87: *>          JOBQ is CHARACTER*1
   88: *>          = 'Q':  Unitary matrix Q is computed;
   89: *>          = 'N':  Q is not computed.
   90: *> \endverbatim
   91: *>
   92: *> \param[in] M
   93: *> \verbatim
   94: *>          M is INTEGER
   95: *>          The number of rows of the matrix A.  M >= 0.
   96: *> \endverbatim
   97: *>
   98: *> \param[in] P
   99: *> \verbatim
  100: *>          P is INTEGER
  101: *>          The number of rows of the matrix B.  P >= 0.
  102: *> \endverbatim
  103: *>
  104: *> \param[in] N
  105: *> \verbatim
  106: *>          N is INTEGER
  107: *>          The number of columns of the matrices A and B.  N >= 0.
  108: *> \endverbatim
  109: *>
  110: *> \param[in,out] A
  111: *> \verbatim
  112: *>          A is COMPLEX*16 array, dimension (LDA,N)
  113: *>          On entry, the M-by-N matrix A.
  114: *>          On exit, A contains the triangular (or trapezoidal) matrix
  115: *>          described in the Purpose section.
  116: *> \endverbatim
  117: *>
  118: *> \param[in] LDA
  119: *> \verbatim
  120: *>          LDA is INTEGER
  121: *>          The leading dimension of the array A. LDA >= max(1,M).
  122: *> \endverbatim
  123: *>
  124: *> \param[in,out] B
  125: *> \verbatim
  126: *>          B is COMPLEX*16 array, dimension (LDB,N)
  127: *>          On entry, the P-by-N matrix B.
  128: *>          On exit, B contains the triangular matrix described in
  129: *>          the Purpose section.
  130: *> \endverbatim
  131: *>
  132: *> \param[in] LDB
  133: *> \verbatim
  134: *>          LDB is INTEGER
  135: *>          The leading dimension of the array B. LDB >= max(1,P).
  136: *> \endverbatim
  137: *>
  138: *> \param[in] TOLA
  139: *> \verbatim
  140: *>          TOLA is DOUBLE PRECISION
  141: *> \endverbatim
  142: *>
  143: *> \param[in] TOLB
  144: *> \verbatim
  145: *>          TOLB is DOUBLE PRECISION
  146: *>
  147: *>          TOLA and TOLB are the thresholds to determine the effective
  148: *>          numerical rank of matrix B and a subblock of A. Generally,
  149: *>          they are set to
  150: *>             TOLA = MAX(M,N)*norm(A)*MAZHEPS,
  151: *>             TOLB = MAX(P,N)*norm(B)*MAZHEPS.
  152: *>          The size of TOLA and TOLB may affect the size of backward
  153: *>          errors of the decomposition.
  154: *> \endverbatim
  155: *>
  156: *> \param[out] K
  157: *> \verbatim
  158: *>          K is INTEGER
  159: *> \endverbatim
  160: *>
  161: *> \param[out] L
  162: *> \verbatim
  163: *>          L is INTEGER
  164: *>
  165: *>          On exit, K and L specify the dimension of the subblocks
  166: *>          described in Purpose section.
  167: *>          K + L = effective numerical rank of (A**H,B**H)**H.
  168: *> \endverbatim
  169: *>
  170: *> \param[out] U
  171: *> \verbatim
  172: *>          U is COMPLEX*16 array, dimension (LDU,M)
  173: *>          If JOBU = 'U', U contains the unitary matrix U.
  174: *>          If JOBU = 'N', U is not referenced.
  175: *> \endverbatim
  176: *>
  177: *> \param[in] LDU
  178: *> \verbatim
  179: *>          LDU is INTEGER
  180: *>          The leading dimension of the array U. LDU >= max(1,M) if
  181: *>          JOBU = 'U'; LDU >= 1 otherwise.
  182: *> \endverbatim
  183: *>
  184: *> \param[out] V
  185: *> \verbatim
  186: *>          V is COMPLEX*16 array, dimension (LDV,P)
  187: *>          If JOBV = 'V', V contains the unitary matrix V.
  188: *>          If JOBV = 'N', V is not referenced.
  189: *> \endverbatim
  190: *>
  191: *> \param[in] LDV
  192: *> \verbatim
  193: *>          LDV is INTEGER
  194: *>          The leading dimension of the array V. LDV >= max(1,P) if
  195: *>          JOBV = 'V'; LDV >= 1 otherwise.
  196: *> \endverbatim
  197: *>
  198: *> \param[out] Q
  199: *> \verbatim
  200: *>          Q is COMPLEX*16 array, dimension (LDQ,N)
  201: *>          If JOBQ = 'Q', Q contains the unitary matrix Q.
  202: *>          If JOBQ = 'N', Q is not referenced.
  203: *> \endverbatim
  204: *>
  205: *> \param[in] LDQ
  206: *> \verbatim
  207: *>          LDQ is INTEGER
  208: *>          The leading dimension of the array Q. LDQ >= max(1,N) if
  209: *>          JOBQ = 'Q'; LDQ >= 1 otherwise.
  210: *> \endverbatim
  211: *>
  212: *> \param[out] IWORK
  213: *> \verbatim
  214: *>          IWORK is INTEGER array, dimension (N)
  215: *> \endverbatim
  216: *>
  217: *> \param[out] RWORK
  218: *> \verbatim
  219: *>          RWORK is DOUBLE PRECISION array, dimension (2*N)
  220: *> \endverbatim
  221: *>
  222: *> \param[out] TAU
  223: *> \verbatim
  224: *>          TAU is COMPLEX*16 array, dimension (N)
  225: *> \endverbatim
  226: *>
  227: *> \param[out] WORK
  228: *> \verbatim
  229: *>          WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
  230: *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
  231: *> \endverbatim
  232: *>
  233: *> \param[in] LWORK
  234: *> \verbatim
  235: *>          LWORK is INTEGER
  236: *>          The dimension of the array WORK.
  237: *>
  238: *>          If LWORK = -1, then a workspace query is assumed; the routine
  239: *>          only calculates the optimal size of the WORK array, returns
  240: *>          this value as the first entry of the WORK array, and no error
  241: *>          message related to LWORK is issued by XERBLA.
  242: *> \endverbatim
  243: *>
  244: *> \param[out] INFO
  245: *> \verbatim
  246: *>          INFO is INTEGER
  247: *>          = 0:  successful exit
  248: *>          < 0:  if INFO = -i, the i-th argument had an illegal value.
  249: *> \endverbatim
  250: *
  251: *  Authors:
  252: *  ========
  253: *
  254: *> \author Univ. of Tennessee 
  255: *> \author Univ. of California Berkeley 
  256: *> \author Univ. of Colorado Denver 
  257: *> \author NAG Ltd. 
  258: *
  259: *> \date August 2015
  260: *
  261: *> \ingroup complex16OTHERcomputational
  262: *
  263: *> \par Further Details:
  264: *  =====================
  265: *
  266: *> \verbatim
  267: *>
  268: *>  The subroutine uses LAPACK subroutine ZGEQP3 for the QR factorization
  269: *>  with column pivoting to detect the effective numerical rank of the
  270: *>  a matrix. It may be replaced by a better rank determination strategy.
  271: *>
  272: *>  ZGGSVP3 replaces the deprecated subroutine ZGGSVP.
  273: *>
  274: *> \endverbatim
  275: *>
  276: * =====================================================================
  277:       SUBROUTINE ZGGSVP3( JOBU, JOBV, JOBQ, M, P, N, A, LDA, B, LDB,
  278:      $                    TOLA, TOLB, K, L, U, LDU, V, LDV, Q, LDQ,
  279:      $                    IWORK, RWORK, TAU, WORK, LWORK, INFO )
  280: *
  281: *  -- LAPACK computational routine (version 3.6.0) --
  282: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  283: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  284: *     August 2015
  285: *
  286:       IMPLICIT NONE
  287: *
  288: *     .. Scalar Arguments ..
  289:       CHARACTER          JOBQ, JOBU, JOBV
  290:       INTEGER            INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P,
  291:      $                   LWORK
  292:       DOUBLE PRECISION   TOLA, TOLB
  293: *     ..
  294: *     .. Array Arguments ..
  295:       INTEGER            IWORK( * )
  296:       DOUBLE PRECISION   RWORK( * )
  297:       COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
  298:      $                   TAU( * ), U( LDU, * ), V( LDV, * ), WORK( * )
  299: *     ..
  300: *
  301: *  =====================================================================
  302: *
  303: *     .. Parameters ..
  304:       COMPLEX*16         CZERO, CONE
  305:       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
  306:      $                   CONE = ( 1.0D+0, 0.0D+0 ) )
  307: *     ..
  308: *     .. Local Scalars ..
  309:       LOGICAL            FORWRD, WANTQ, WANTU, WANTV, LQUERY
  310:       INTEGER            I, J, LWKOPT
  311:       COMPLEX*16         T
  312: *     ..
  313: *     .. External Functions ..
  314:       LOGICAL            LSAME
  315:       EXTERNAL           LSAME
  316: *     ..
  317: *     .. External Subroutines ..
  318:       EXTERNAL           XERBLA, ZGEQP3, ZGEQR2, ZGERQ2, ZLACPY, ZLAPMT,
  319:      $                   ZLASET, ZUNG2R, ZUNM2R, ZUNMR2
  320: *     ..
  321: *     .. Intrinsic Functions ..
  322:       INTRINSIC          ABS, DBLE, DIMAG, MAX, MIN
  323: *     ..
  324: *     .. Executable Statements ..
  325: *
  326: *     Test the input parameters
  327: *
  328:       WANTU = LSAME( JOBU, 'U' )
  329:       WANTV = LSAME( JOBV, 'V' )
  330:       WANTQ = LSAME( JOBQ, 'Q' )
  331:       FORWRD = .TRUE.
  332:       LQUERY = ( LWORK.EQ.-1 )
  333:       LWKOPT = 1
  334: *
  335: *     Test the input arguments
  336: *
  337:       INFO = 0
  338:       IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN
  339:          INFO = -1
  340:       ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN
  341:          INFO = -2
  342:       ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN
  343:          INFO = -3
  344:       ELSE IF( M.LT.0 ) THEN
  345:          INFO = -4
  346:       ELSE IF( P.LT.0 ) THEN
  347:          INFO = -5
  348:       ELSE IF( N.LT.0 ) THEN
  349:          INFO = -6
  350:       ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
  351:          INFO = -8
  352:       ELSE IF( LDB.LT.MAX( 1, P ) ) THEN
  353:          INFO = -10
  354:       ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN
  355:          INFO = -16
  356:       ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN
  357:          INFO = -18
  358:       ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN
  359:          INFO = -20
  360:       ELSE IF( LWORK.LT.1 .AND. .NOT.LQUERY ) THEN
  361:          INFO = -24
  362:       END IF
  363: *
  364: *     Compute workspace
  365: *
  366:       IF( INFO.EQ.0 ) THEN
  367:          CALL ZGEQP3( P, N, B, LDB, IWORK, TAU, WORK, -1, RWORK, INFO )
  368:          LWKOPT = INT( WORK ( 1 ) )
  369:          IF( WANTV ) THEN
  370:             LWKOPT = MAX( LWKOPT, P )
  371:          END IF
  372:          LWKOPT = MAX( LWKOPT, MIN( N, P ) )
  373:          LWKOPT = MAX( LWKOPT, M )
  374:          IF( WANTQ ) THEN
  375:             LWKOPT = MAX( LWKOPT, N )
  376:          END IF
  377:          CALL ZGEQP3( M, N, A, LDA, IWORK, TAU, WORK, -1, RWORK, INFO )
  378:          LWKOPT = MAX( LWKOPT, INT( WORK ( 1 ) ) )
  379:          LWKOPT = MAX( 1, LWKOPT )
  380:          WORK( 1 ) = DCMPLX( LWKOPT )
  381:       END IF
  382: *
  383:       IF( INFO.NE.0 ) THEN
  384:          CALL XERBLA( 'ZGGSVP3', -INFO )
  385:          RETURN
  386:       END IF
  387:       IF( LQUERY ) THEN
  388:          RETURN
  389:       ENDIF
  390: *
  391: *     QR with column pivoting of B: B*P = V*( S11 S12 )
  392: *                                           (  0   0  )
  393: *
  394:       DO 10 I = 1, N
  395:          IWORK( I ) = 0
  396:    10 CONTINUE
  397:       CALL ZGEQP3( P, N, B, LDB, IWORK, TAU, WORK, LWORK, RWORK, INFO )
  398: *
  399: *     Update A := A*P
  400: *
  401:       CALL ZLAPMT( FORWRD, M, N, A, LDA, IWORK )
  402: *
  403: *     Determine the effective rank of matrix B.
  404: *
  405:       L = 0
  406:       DO 20 I = 1, MIN( P, N )
  407:          IF( ABS( B( I, I ) ).GT.TOLB )
  408:      $      L = L + 1
  409:    20 CONTINUE
  410: *
  411:       IF( WANTV ) THEN
  412: *
  413: *        Copy the details of V, and form V.
  414: *
  415:          CALL ZLASET( 'Full', P, P, CZERO, CZERO, V, LDV )
  416:          IF( P.GT.1 )
  417:      $      CALL ZLACPY( 'Lower', P-1, N, B( 2, 1 ), LDB, V( 2, 1 ),
  418:      $                   LDV )
  419:          CALL ZUNG2R( P, P, MIN( P, N ), V, LDV, TAU, WORK, INFO )
  420:       END IF
  421: *
  422: *     Clean up B
  423: *
  424:       DO 40 J = 1, L - 1
  425:          DO 30 I = J + 1, L
  426:             B( I, J ) = CZERO
  427:    30    CONTINUE
  428:    40 CONTINUE
  429:       IF( P.GT.L )
  430:      $   CALL ZLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB )
  431: *
  432:       IF( WANTQ ) THEN
  433: *
  434: *        Set Q = I and Update Q := Q*P
  435: *
  436:          CALL ZLASET( 'Full', N, N, CZERO, CONE, Q, LDQ )
  437:          CALL ZLAPMT( FORWRD, N, N, Q, LDQ, IWORK )
  438:       END IF
  439: *
  440:       IF( P.GE.L .AND. N.NE.L ) THEN
  441: *
  442: *        RQ factorization of ( S11 S12 ) = ( 0 S12 )*Z
  443: *
  444:          CALL ZGERQ2( L, N, B, LDB, TAU, WORK, INFO )
  445: *
  446: *        Update A := A*Z**H
  447: *
  448:          CALL ZUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB,
  449:      $                TAU, A, LDA, WORK, INFO )
  450:          IF( WANTQ ) THEN
  451: *
  452: *           Update Q := Q*Z**H
  453: *
  454:             CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N, L, B,
  455:      $                   LDB, TAU, Q, LDQ, WORK, INFO )
  456:          END IF
  457: *
  458: *        Clean up B
  459: *
  460:          CALL ZLASET( 'Full', L, N-L, CZERO, CZERO, B, LDB )
  461:          DO 60 J = N - L + 1, N
  462:             DO 50 I = J - N + L + 1, L
  463:                B( I, J ) = CZERO
  464:    50       CONTINUE
  465:    60    CONTINUE
  466: *
  467:       END IF
  468: *
  469: *     Let              N-L     L
  470: *                A = ( A11    A12 ) M,
  471: *
  472: *     then the following does the complete QR decomposition of A11:
  473: *
  474: *              A11 = U*(  0  T12 )*P1**H
  475: *                      (  0   0  )
  476: *
  477:       DO 70 I = 1, N - L
  478:          IWORK( I ) = 0
  479:    70 CONTINUE
  480:       CALL ZGEQP3( M, N-L, A, LDA, IWORK, TAU, WORK, LWORK, RWORK,
  481:      $             INFO )
  482: *
  483: *     Determine the effective rank of A11
  484: *
  485:       K = 0
  486:       DO 80 I = 1, MIN( M, N-L )
  487:          IF( ABS( A( I, I ) ).GT.TOLA )
  488:      $      K = K + 1
  489:    80 CONTINUE
  490: *
  491: *     Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N )
  492: *
  493:       CALL ZUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ),
  494:      $             A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO )
  495: *
  496:       IF( WANTU ) THEN
  497: *
  498: *        Copy the details of U, and form U
  499: *
  500:          CALL ZLASET( 'Full', M, M, CZERO, CZERO, U, LDU )
  501:          IF( M.GT.1 )
  502:      $      CALL ZLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ),
  503:      $                   LDU )
  504:          CALL ZUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO )
  505:       END IF
  506: *
  507:       IF( WANTQ ) THEN
  508: *
  509: *        Update Q( 1:N, 1:N-L )  = Q( 1:N, 1:N-L )*P1
  510: *
  511:          CALL ZLAPMT( FORWRD, N, N-L, Q, LDQ, IWORK )
  512:       END IF
  513: *
  514: *     Clean up A: set the strictly lower triangular part of
  515: *     A(1:K, 1:K) = 0, and A( K+1:M, 1:N-L ) = 0.
  516: *
  517:       DO 100 J = 1, K - 1
  518:          DO 90 I = J + 1, K
  519:             A( I, J ) = CZERO
  520:    90    CONTINUE
  521:   100 CONTINUE
  522:       IF( M.GT.K )
  523:      $   CALL ZLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA )
  524: *
  525:       IF( N-L.GT.K ) THEN
  526: *
  527: *        RQ factorization of ( T11 T12 ) = ( 0 T12 )*Z1
  528: *
  529:          CALL ZGERQ2( K, N-L, A, LDA, TAU, WORK, INFO )
  530: *
  531:          IF( WANTQ ) THEN
  532: *
  533: *           Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H
  534: *
  535:             CALL ZUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A,
  536:      $                   LDA, TAU, Q, LDQ, WORK, INFO )
  537:          END IF
  538: *
  539: *        Clean up A
  540: *
  541:          CALL ZLASET( 'Full', K, N-L-K, CZERO, CZERO, A, LDA )
  542:          DO 120 J = N - L - K + 1, N - L
  543:             DO 110 I = J - N + L + K + 1, K
  544:                A( I, J ) = CZERO
  545:   110       CONTINUE
  546:   120    CONTINUE
  547: *
  548:       END IF
  549: *
  550:       IF( M.GT.K ) THEN
  551: *
  552: *        QR factorization of A( K+1:M,N-L+1:N )
  553: *
  554:          CALL ZGEQR2( M-K, L, A( K+1, N-L+1 ), LDA, TAU, WORK, INFO )
  555: *
  556:          IF( WANTU ) THEN
  557: *
  558: *           Update U(:,K+1:M) := U(:,K+1:M)*U1
  559: *
  560:             CALL ZUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ),
  561:      $                   A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU,
  562:      $                   WORK, INFO )
  563:          END IF
  564: *
  565: *        Clean up
  566: *
  567:          DO 140 J = N - L + 1, N
  568:             DO 130 I = J - N + K + L + 1, M
  569:                A( I, J ) = CZERO
  570:   130       CONTINUE
  571:   140    CONTINUE
  572: *
  573:       END IF
  574: *
  575:       WORK( 1 ) = DCMPLX( LWKOPT )
  576:       RETURN
  577: *
  578: *     End of ZGGSVP3
  579: *
  580:       END

CVSweb interface <joel.bertrand@systella.fr>