Annotation of rpl/lapack/lapack/dormrz.f, revision 1.11

1.9       bertrand    1: *> \brief \b DORMRZ
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
                      5: * Online html documentation available at 
                      6: *            http://www.netlib.org/lapack/explore-html/ 
                      7: *
                      8: *> \htmlonly
                      9: *> Download DORMRZ + dependencies 
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormrz.f"> 
                     11: *> [TGZ]</a> 
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormrz.f"> 
                     13: *> [ZIP]</a> 
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormrz.f"> 
                     15: *> [TXT]</a>
                     16: *> \endhtmlonly 
                     17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
                     22: *                          WORK, LWORK, INFO )
                     23: * 
                     24: *       .. Scalar Arguments ..
                     25: *       CHARACTER          SIDE, TRANS
                     26: *       INTEGER            INFO, K, L, LDA, LDC, LWORK, M, N
                     27: *       ..
                     28: *       .. Array Arguments ..
                     29: *       DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
                     30: *       ..
                     31: *  
                     32: *
                     33: *> \par Purpose:
                     34: *  =============
                     35: *>
                     36: *> \verbatim
                     37: *>
                     38: *> DORMRZ overwrites the general real M-by-N matrix C with
                     39: *>
                     40: *>                 SIDE = 'L'     SIDE = 'R'
                     41: *> TRANS = 'N':      Q * C          C * Q
                     42: *> TRANS = 'T':      Q**T * C       C * Q**T
                     43: *>
                     44: *> where Q is a real orthogonal matrix defined as the product of k
                     45: *> elementary reflectors
                     46: *>
                     47: *>       Q = H(1) H(2) . . . H(k)
                     48: *>
                     49: *> as returned by DTZRZF. Q is of order M if SIDE = 'L' and of order N
                     50: *> if SIDE = 'R'.
                     51: *> \endverbatim
                     52: *
                     53: *  Arguments:
                     54: *  ==========
                     55: *
                     56: *> \param[in] SIDE
                     57: *> \verbatim
                     58: *>          SIDE is CHARACTER*1
                     59: *>          = 'L': apply Q or Q**T from the Left;
                     60: *>          = 'R': apply Q or Q**T from the Right.
                     61: *> \endverbatim
                     62: *>
                     63: *> \param[in] TRANS
                     64: *> \verbatim
                     65: *>          TRANS is CHARACTER*1
                     66: *>          = 'N':  No transpose, apply Q;
                     67: *>          = 'T':  Transpose, apply Q**T.
                     68: *> \endverbatim
                     69: *>
                     70: *> \param[in] M
                     71: *> \verbatim
                     72: *>          M is INTEGER
                     73: *>          The number of rows of the matrix C. M >= 0.
                     74: *> \endverbatim
                     75: *>
                     76: *> \param[in] N
                     77: *> \verbatim
                     78: *>          N is INTEGER
                     79: *>          The number of columns of the matrix C. N >= 0.
                     80: *> \endverbatim
                     81: *>
                     82: *> \param[in] K
                     83: *> \verbatim
                     84: *>          K is INTEGER
                     85: *>          The number of elementary reflectors whose product defines
                     86: *>          the matrix Q.
                     87: *>          If SIDE = 'L', M >= K >= 0;
                     88: *>          if SIDE = 'R', N >= K >= 0.
                     89: *> \endverbatim
                     90: *>
                     91: *> \param[in] L
                     92: *> \verbatim
                     93: *>          L is INTEGER
                     94: *>          The number of columns of the matrix A containing
                     95: *>          the meaningful part of the Householder reflectors.
                     96: *>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
                     97: *> \endverbatim
                     98: *>
                     99: *> \param[in] A
                    100: *> \verbatim
                    101: *>          A is DOUBLE PRECISION array, dimension
                    102: *>                               (LDA,M) if SIDE = 'L',
                    103: *>                               (LDA,N) if SIDE = 'R'
                    104: *>          The i-th row must contain the vector which defines the
                    105: *>          elementary reflector H(i), for i = 1,2,...,k, as returned by
                    106: *>          DTZRZF in the last k rows of its array argument A.
                    107: *>          A is modified by the routine but restored on exit.
                    108: *> \endverbatim
                    109: *>
                    110: *> \param[in] LDA
                    111: *> \verbatim
                    112: *>          LDA is INTEGER
                    113: *>          The leading dimension of the array A. LDA >= max(1,K).
                    114: *> \endverbatim
                    115: *>
                    116: *> \param[in] TAU
                    117: *> \verbatim
                    118: *>          TAU is DOUBLE PRECISION array, dimension (K)
                    119: *>          TAU(i) must contain the scalar factor of the elementary
                    120: *>          reflector H(i), as returned by DTZRZF.
                    121: *> \endverbatim
                    122: *>
                    123: *> \param[in,out] C
                    124: *> \verbatim
                    125: *>          C is DOUBLE PRECISION array, dimension (LDC,N)
                    126: *>          On entry, the M-by-N matrix C.
                    127: *>          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
                    128: *> \endverbatim
                    129: *>
                    130: *> \param[in] LDC
                    131: *> \verbatim
                    132: *>          LDC is INTEGER
                    133: *>          The leading dimension of the array C. LDC >= max(1,M).
                    134: *> \endverbatim
                    135: *>
                    136: *> \param[out] WORK
                    137: *> \verbatim
                    138: *>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
                    139: *>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
                    140: *> \endverbatim
                    141: *>
                    142: *> \param[in] LWORK
                    143: *> \verbatim
                    144: *>          LWORK is INTEGER
                    145: *>          The dimension of the array WORK.
                    146: *>          If SIDE = 'L', LWORK >= max(1,N);
                    147: *>          if SIDE = 'R', LWORK >= max(1,M).
                    148: *>          For optimum performance LWORK >= N*NB if SIDE = 'L', and
                    149: *>          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
                    150: *>          blocksize.
                    151: *>
                    152: *>          If LWORK = -1, then a workspace query is assumed; the routine
                    153: *>          only calculates the optimal size of the WORK array, returns
                    154: *>          this value as the first entry of the WORK array, and no error
                    155: *>          message related to LWORK is issued by XERBLA.
                    156: *> \endverbatim
                    157: *>
                    158: *> \param[out] INFO
                    159: *> \verbatim
                    160: *>          INFO is INTEGER
                    161: *>          = 0:  successful exit
                    162: *>          < 0:  if INFO = -i, the i-th argument had an illegal value
                    163: *> \endverbatim
                    164: *
                    165: *  Authors:
                    166: *  ========
                    167: *
                    168: *> \author Univ. of Tennessee 
                    169: *> \author Univ. of California Berkeley 
                    170: *> \author Univ. of Colorado Denver 
                    171: *> \author NAG Ltd. 
                    172: *
                    173: *> \date November 2011
                    174: *
                    175: *> \ingroup doubleOTHERcomputational
                    176: *
                    177: *> \par Contributors:
                    178: *  ==================
                    179: *>
                    180: *>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
                    181: *
                    182: *> \par Further Details:
                    183: *  =====================
                    184: *>
                    185: *> \verbatim
                    186: *> \endverbatim
                    187: *>
                    188: *  =====================================================================
1.1       bertrand  189:       SUBROUTINE DORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
                    190:      $                   WORK, LWORK, INFO )
                    191: *
1.9       bertrand  192: *  -- LAPACK computational routine (version 3.4.0) --
1.1       bertrand  193: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    194: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9       bertrand  195: *     November 2011
1.1       bertrand  196: *
                    197: *     .. Scalar Arguments ..
                    198:       CHARACTER          SIDE, TRANS
                    199:       INTEGER            INFO, K, L, LDA, LDC, LWORK, M, N
                    200: *     ..
                    201: *     .. Array Arguments ..
                    202:       DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
                    203: *     ..
                    204: *
                    205: *  =====================================================================
                    206: *
                    207: *     .. Parameters ..
                    208:       INTEGER            NBMAX, LDT
                    209:       PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
                    210: *     ..
                    211: *     .. Local Scalars ..
                    212:       LOGICAL            LEFT, LQUERY, NOTRAN
                    213:       CHARACTER          TRANST
                    214:       INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JA, JC,
                    215:      $                   LDWORK, LWKOPT, MI, NB, NBMIN, NI, NQ, NW
                    216: *     ..
                    217: *     .. Local Arrays ..
                    218:       DOUBLE PRECISION   T( LDT, NBMAX )
                    219: *     ..
                    220: *     .. External Functions ..
                    221:       LOGICAL            LSAME
                    222:       INTEGER            ILAENV
                    223:       EXTERNAL           LSAME, ILAENV
                    224: *     ..
                    225: *     .. External Subroutines ..
                    226:       EXTERNAL           DLARZB, DLARZT, DORMR3, XERBLA
                    227: *     ..
                    228: *     .. Intrinsic Functions ..
                    229:       INTRINSIC          MAX, MIN
                    230: *     ..
                    231: *     .. Executable Statements ..
                    232: *
                    233: *     Test the input arguments
                    234: *
                    235:       INFO = 0
                    236:       LEFT = LSAME( SIDE, 'L' )
                    237:       NOTRAN = LSAME( TRANS, 'N' )
                    238:       LQUERY = ( LWORK.EQ.-1 )
                    239: *
                    240: *     NQ is the order of Q and NW is the minimum dimension of WORK
                    241: *
                    242:       IF( LEFT ) THEN
                    243:          NQ = M
                    244:          NW = MAX( 1, N )
                    245:       ELSE
                    246:          NQ = N
                    247:          NW = MAX( 1, M )
                    248:       END IF
                    249:       IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
                    250:          INFO = -1
                    251:       ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
                    252:          INFO = -2
                    253:       ELSE IF( M.LT.0 ) THEN
                    254:          INFO = -3
                    255:       ELSE IF( N.LT.0 ) THEN
                    256:          INFO = -4
                    257:       ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
                    258:          INFO = -5
                    259:       ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
                    260:      $         ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
                    261:          INFO = -6
                    262:       ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
                    263:          INFO = -8
                    264:       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
                    265:          INFO = -11
                    266:       END IF
                    267: *
                    268:       IF( INFO.EQ.0 ) THEN
                    269:          IF( M.EQ.0 .OR. N.EQ.0 ) THEN
                    270:             LWKOPT = 1
                    271:          ELSE
                    272: *
                    273: *           Determine the block size.  NB may be at most NBMAX, where
                    274: *           NBMAX is used to define the local array T.
                    275: *
                    276:             NB = MIN( NBMAX, ILAENV( 1, 'DORMRQ', SIDE // TRANS, M, N,
                    277:      $                               K, -1 ) )
                    278:             LWKOPT = NW*NB
                    279:          END IF
                    280:          WORK( 1 ) = LWKOPT
                    281: *
                    282:          IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
                    283:             INFO = -13
                    284:          END IF
                    285:       END IF
                    286: *
                    287:       IF( INFO.NE.0 ) THEN
                    288:          CALL XERBLA( 'DORMRZ', -INFO )
                    289:          RETURN
                    290:       ELSE IF( LQUERY ) THEN
                    291:          RETURN
                    292:       END IF
                    293: *
                    294: *     Quick return if possible
                    295: *
                    296:       IF( M.EQ.0 .OR. N.EQ.0 ) THEN
                    297:          WORK( 1 ) = 1
                    298:          RETURN
                    299:       END IF
                    300: *
                    301:       NBMIN = 2
                    302:       LDWORK = NW
                    303:       IF( NB.GT.1 .AND. NB.LT.K ) THEN
                    304:          IWS = NW*NB
                    305:          IF( LWORK.LT.IWS ) THEN
                    306:             NB = LWORK / LDWORK
                    307:             NBMIN = MAX( 2, ILAENV( 2, 'DORMRQ', SIDE // TRANS, M, N, K,
                    308:      $              -1 ) )
                    309:          END IF
                    310:       ELSE
                    311:          IWS = NW
                    312:       END IF
                    313: *
                    314:       IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
                    315: *
                    316: *        Use unblocked code
                    317: *
                    318:          CALL DORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
                    319:      $                WORK, IINFO )
                    320:       ELSE
                    321: *
                    322: *        Use blocked code
                    323: *
                    324:          IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
                    325:      $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
                    326:             I1 = 1
                    327:             I2 = K
                    328:             I3 = NB
                    329:          ELSE
                    330:             I1 = ( ( K-1 ) / NB )*NB + 1
                    331:             I2 = 1
                    332:             I3 = -NB
                    333:          END IF
                    334: *
                    335:          IF( LEFT ) THEN
                    336:             NI = N
                    337:             JC = 1
                    338:             JA = M - L + 1
                    339:          ELSE
                    340:             MI = M
                    341:             IC = 1
                    342:             JA = N - L + 1
                    343:          END IF
                    344: *
                    345:          IF( NOTRAN ) THEN
                    346:             TRANST = 'T'
                    347:          ELSE
                    348:             TRANST = 'N'
                    349:          END IF
                    350: *
                    351:          DO 10 I = I1, I2, I3
                    352:             IB = MIN( NB, K-I+1 )
                    353: *
                    354: *           Form the triangular factor of the block reflector
                    355: *           H = H(i+ib-1) . . . H(i+1) H(i)
                    356: *
                    357:             CALL DLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA,
                    358:      $                   TAU( I ), T, LDT )
                    359: *
                    360:             IF( LEFT ) THEN
                    361: *
1.8       bertrand  362: *              H or H**T is applied to C(i:m,1:n)
1.1       bertrand  363: *
                    364:                MI = M - I + 1
                    365:                IC = I
                    366:             ELSE
                    367: *
1.8       bertrand  368: *              H or H**T is applied to C(1:m,i:n)
1.1       bertrand  369: *
                    370:                NI = N - I + 1
                    371:                JC = I
                    372:             END IF
                    373: *
1.8       bertrand  374: *           Apply H or H**T
1.1       bertrand  375: *
                    376:             CALL DLARZB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
                    377:      $                   IB, L, A( I, JA ), LDA, T, LDT, C( IC, JC ),
                    378:      $                   LDC, WORK, LDWORK )
                    379:    10    CONTINUE
                    380: *
                    381:       END IF
                    382: *
                    383:       WORK( 1 ) = LWKOPT
                    384: *
                    385:       RETURN
                    386: *
                    387: *     End of DORMRZ
                    388: *
                    389:       END

CVSweb interface <joel.bertrand@systella.fr>