File:  [local] / rpl / lapack / lapack / zgemlq.f
Revision 1.5: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:39:17 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief \b ZGEMLQ
    2: *
    3: *  Definition:
    4: *  ===========
    5: *
    6: *      SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T,
    7: *     $                   TSIZE, C, LDC, WORK, LWORK, INFO )
    8: *
    9: *
   10: *     .. Scalar Arguments ..
   11: *      CHARACTER          SIDE, TRANS
   12: *      INTEGER            INFO, LDA, M, N, K, LDT, TSIZE, LWORK, LDC
   13: *     ..
   14: *     .. Array Arguments ..
   15: *      COMPLEX*16         A( LDA, * ), T( * ), C(LDC, * ), WORK( * )
   16: *> \par Purpose:
   17: *  =============
   18: *>
   19: *> \verbatim
   20: *>
   21: *>     ZGEMLQ overwrites the general real M-by-N matrix C with
   22: *>
   23: *>                      SIDE = 'L'     SIDE = 'R'
   24: *>      TRANS = 'N':      Q * C          C * Q
   25: *>      TRANS = 'C':      Q**H * C       C * Q**H
   26: *>      where Q is a complex unitary matrix defined as the product
   27: *>      of blocked elementary reflectors computed by short wide
   28: *>      LQ factorization (ZGELQ)
   29: *>
   30: *> \endverbatim
   31: *
   32: *  Arguments:
   33: *  ==========
   34: *
   35: *> \param[in] SIDE
   36: *> \verbatim
   37: *>          SIDE is CHARACTER*1
   38: *>          = 'L': apply Q or Q**H from the Left;
   39: *>          = 'R': apply Q or Q**H from the Right.
   40: *> \endverbatim
   41: *>
   42: *> \param[in] TRANS
   43: *> \verbatim
   44: *>          TRANS is CHARACTER*1
   45: *>          = 'N':  No transpose, apply Q;
   46: *>          = 'C':  Conjugate transpose, apply Q**H.
   47: *> \endverbatim
   48: *>
   49: *> \param[in] M
   50: *> \verbatim
   51: *>          M is INTEGER
   52: *>          The number of rows of the matrix A.  M >=0.
   53: *> \endverbatim
   54: *>
   55: *> \param[in] N
   56: *> \verbatim
   57: *>          N is INTEGER
   58: *>          The number of columns of the matrix C. N >= 0.
   59: *> \endverbatim
   60: *>
   61: *> \param[in] K
   62: *> \verbatim
   63: *>          K is INTEGER
   64: *>          The number of elementary reflectors whose product defines
   65: *>          the matrix Q.
   66: *>          If SIDE = 'L', M >= K >= 0;
   67: *>          if SIDE = 'R', N >= K >= 0.
   68: *>
   69: *> \endverbatim
   70: *>
   71: *> \param[in] A
   72: *> \verbatim
   73: *>          A is COMPLEX*16 array, dimension
   74: *>                               (LDA,M) if SIDE = 'L',
   75: *>                               (LDA,N) if SIDE = 'R'
   76: *>          Part of the data structure to represent Q as returned by ZGELQ.
   77: *> \endverbatim
   78: *>
   79: *> \param[in] LDA
   80: *> \verbatim
   81: *>          LDA is INTEGER
   82: *>          The leading dimension of the array A. LDA >= max(1,K).
   83: *> \endverbatim
   84: *>
   85: *> \param[in] T
   86: *> \verbatim
   87: *>          T is COMPLEX*16 array, dimension (MAX(5,TSIZE)).
   88: *>          Part of the data structure to represent Q as returned by ZGELQ.
   89: *> \endverbatim
   90: *>
   91: *> \param[in] TSIZE
   92: *> \verbatim
   93: *>          TSIZE is INTEGER
   94: *>          The dimension of the array T. TSIZE >= 5.
   95: *> \endverbatim
   96: *>
   97: *> \param[in,out] C
   98: *> \verbatim
   99: *>          C is COMPLEX*16 array, dimension (LDC,N)
  100: *>          On entry, the M-by-N matrix C.
  101: *>          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
  102: *> \endverbatim
  103: *>
  104: *> \param[in] LDC
  105: *> \verbatim
  106: *>          LDC is INTEGER
  107: *>          The leading dimension of the array C. LDC >= max(1,M).
  108: *> \endverbatim
  109: *>
  110: *> \param[out] WORK
  111: *> \verbatim
  112: *>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
  113: *> \endverbatim
  114: *>
  115: *> \param[in] LWORK
  116: *> \verbatim
  117: *>          LWORK is INTEGER
  118: *>          The dimension of the array WORK.
  119: *>          If LWORK = -1, then a workspace query is assumed. The routine
  120: *>          only calculates the size of the WORK array, returns this
  121: *>          value as WORK(1), and no error message related to WORK 
  122: *>          is issued by XERBLA.
  123: *> \endverbatim
  124: *>
  125: *> \param[out] INFO
  126: *> \verbatim
  127: *>          INFO is INTEGER
  128: *>          = 0:  successful exit
  129: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
  130: *> \endverbatim
  131: *
  132: *  Authors:
  133: *  ========
  134: *
  135: *> \author Univ. of Tennessee
  136: *> \author Univ. of California Berkeley
  137: *> \author Univ. of Colorado Denver
  138: *> \author NAG Ltd.
  139: *
  140: *> \par Further Details
  141: *  ====================
  142: *>
  143: *> \verbatim
  144: *>
  145: *> These details are particular for this LAPACK implementation. Users should not 
  146: *> take them for granted. These details may change in the future, and are not likely
  147: *> true for another LAPACK implementation. These details are relevant if one wants
  148: *> to try to understand the code. They are not part of the interface.
  149: *>
  150: *> In this version,
  151: *>
  152: *>          T(2): row block size (MB)
  153: *>          T(3): column block size (NB)
  154: *>          T(6:TSIZE): data structure needed for Q, computed by
  155: *>                           ZLASWLQ or ZGELQT
  156: *>
  157: *>  Depending on the matrix dimensions M and N, and row and column
  158: *>  block sizes MB and NB returned by ILAENV, ZGELQ will use either
  159: *>  ZLASWLQ (if the matrix is wide-and-short) or ZGELQT to compute
  160: *>  the LQ factorization.
  161: *>  This version of ZGEMLQ will use either ZLAMSWLQ or ZGEMLQT to 
  162: *>  multiply matrix Q by another matrix.
  163: *>  Further Details in ZLAMSWLQ or ZGEMLQT.
  164: *> \endverbatim
  165: *>
  166: *  =====================================================================
  167:       SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, T, TSIZE,
  168:      $                   C, LDC, WORK, LWORK, INFO )
  169: *
  170: *  -- LAPACK computational routine --
  171: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  172: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  173: *
  174: *     .. Scalar Arguments ..
  175:       CHARACTER          SIDE, TRANS
  176:       INTEGER            INFO, LDA, M, N, K, TSIZE, LWORK, LDC
  177: *     ..
  178: *     .. Array Arguments ..
  179:       COMPLEX*16         A( LDA, * ), T( * ), C( LDC, * ), WORK( * )
  180: *     ..
  181: *
  182: * =====================================================================
  183: *
  184: *     ..
  185: *     .. Local Scalars ..
  186:       LOGICAL            LEFT, RIGHT, TRAN, NOTRAN, LQUERY
  187:       INTEGER            MB, NB, LW, NBLCKS, MN
  188: *     ..
  189: *     .. External Functions ..
  190:       LOGICAL            LSAME
  191:       EXTERNAL           LSAME
  192: *     ..
  193: *     .. External Subroutines ..
  194:       EXTERNAL           ZLAMSWLQ, ZGEMLQT, XERBLA
  195: *     ..
  196: *     .. Intrinsic Functions ..
  197:       INTRINSIC          INT, MAX, MIN, MOD
  198: *     ..
  199: *     .. Executable Statements ..
  200: *
  201: *     Test the input arguments
  202: *
  203:       LQUERY  = LWORK.EQ.-1
  204:       NOTRAN  = LSAME( TRANS, 'N' )
  205:       TRAN    = LSAME( TRANS, 'C' )
  206:       LEFT    = LSAME( SIDE, 'L' )
  207:       RIGHT   = LSAME( SIDE, 'R' )
  208: *
  209:       MB = INT( T( 2 ) )
  210:       NB = INT( T( 3 ) )
  211:       IF( LEFT ) THEN
  212:         LW = N * MB
  213:         MN = M
  214:       ELSE
  215:         LW = M * MB
  216:         MN = N
  217:       END IF
  218: *
  219:       IF( ( NB.GT.K ) .AND. ( MN.GT.K ) ) THEN
  220:         IF( MOD( MN - K, NB - K ) .EQ. 0 ) THEN
  221:           NBLCKS = ( MN - K ) / ( NB - K )
  222:         ELSE
  223:           NBLCKS = ( MN - K ) / ( NB - K ) + 1
  224:         END IF
  225:       ELSE
  226:         NBLCKS = 1
  227:       END IF
  228: *
  229:       INFO = 0
  230:       IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
  231:         INFO = -1
  232:       ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
  233:         INFO = -2
  234:       ELSE IF( M.LT.0 ) THEN
  235:         INFO = -3
  236:       ELSE IF( N.LT.0 ) THEN
  237:         INFO = -4
  238:       ELSE IF( K.LT.0 .OR. K.GT.MN ) THEN
  239:         INFO = -5
  240:       ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
  241:         INFO = -7
  242:       ELSE IF( TSIZE.LT.5 ) THEN
  243:         INFO = -9
  244:       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
  245:         INFO = -11
  246:       ELSE IF( ( LWORK.LT.MAX( 1, LW ) ) .AND. ( .NOT.LQUERY ) ) THEN
  247:         INFO = -13
  248:       END IF
  249: *
  250:       IF( INFO.EQ.0 ) THEN
  251:         WORK( 1 ) = LW
  252:       END IF
  253: *
  254:       IF( INFO.NE.0 ) THEN
  255:         CALL XERBLA( 'ZGEMLQ', -INFO )
  256:         RETURN
  257:       ELSE IF( LQUERY ) THEN
  258:         RETURN
  259:       END IF
  260: *
  261: *     Quick return if possible
  262: *
  263:       IF( MIN( M, N, K ).EQ.0 ) THEN
  264:         RETURN
  265:       END IF
  266: *
  267:       IF( ( LEFT .AND. M.LE.K ) .OR. ( RIGHT .AND. N.LE.K )
  268:      $     .OR. ( NB.LE.K ) .OR. ( NB.GE.MAX( M, N, K ) ) ) THEN
  269:         CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA,
  270:      $                T( 6 ), MB, C, LDC, WORK, INFO )
  271:       ELSE
  272:         CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T( 6 ),
  273:      $                 MB, C, LDC, WORK, LWORK, INFO )
  274:       END IF
  275: *
  276:       WORK( 1 ) = LW
  277: *
  278:       RETURN
  279: *
  280: *     End of ZGEMLQ
  281: *
  282:       END

CVSweb interface <joel.bertrand@systella.fr>