Annotation of rpl/lapack/lapack/zlarzb.f, revision 1.10

1.9       bertrand    1: *> \brief \b ZLARZB
                      2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
                      5: * Online html documentation available at 
                      6: *            http://www.netlib.org/lapack/explore-html/ 
                      7: *
                      8: *> \htmlonly
                      9: *> Download ZLARZB + dependencies 
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlarzb.f"> 
                     11: *> [TGZ]</a> 
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlarzb.f"> 
                     13: *> [ZIP]</a> 
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlarzb.f"> 
                     15: *> [TXT]</a>
                     16: *> \endhtmlonly 
                     17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE ZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
                     22: *                          LDV, T, LDT, C, LDC, WORK, LDWORK )
                     23: * 
                     24: *       .. Scalar Arguments ..
                     25: *       CHARACTER          DIRECT, SIDE, STOREV, TRANS
                     26: *       INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
                     27: *       ..
                     28: *       .. Array Arguments ..
                     29: *       COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
                     30: *      $                   WORK( LDWORK, * )
                     31: *       ..
                     32: *  
                     33: *
                     34: *> \par Purpose:
                     35: *  =============
                     36: *>
                     37: *> \verbatim
                     38: *>
                     39: *> ZLARZB applies a complex block reflector H or its transpose H**H
                     40: *> to a complex distributed M-by-N  C from the left or the right.
                     41: *>
                     42: *> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
                     43: *> \endverbatim
                     44: *
                     45: *  Arguments:
                     46: *  ==========
                     47: *
                     48: *> \param[in] SIDE
                     49: *> \verbatim
                     50: *>          SIDE is CHARACTER*1
                     51: *>          = 'L': apply H or H**H from the Left
                     52: *>          = 'R': apply H or H**H from the Right
                     53: *> \endverbatim
                     54: *>
                     55: *> \param[in] TRANS
                     56: *> \verbatim
                     57: *>          TRANS is CHARACTER*1
                     58: *>          = 'N': apply H (No transpose)
                     59: *>          = 'C': apply H**H (Conjugate transpose)
                     60: *> \endverbatim
                     61: *>
                     62: *> \param[in] DIRECT
                     63: *> \verbatim
                     64: *>          DIRECT is CHARACTER*1
                     65: *>          Indicates how H is formed from a product of elementary
                     66: *>          reflectors
                     67: *>          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
                     68: *>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
                     69: *> \endverbatim
                     70: *>
                     71: *> \param[in] STOREV
                     72: *> \verbatim
                     73: *>          STOREV is CHARACTER*1
                     74: *>          Indicates how the vectors which define the elementary
                     75: *>          reflectors are stored:
                     76: *>          = 'C': Columnwise                        (not supported yet)
                     77: *>          = 'R': Rowwise
                     78: *> \endverbatim
                     79: *>
                     80: *> \param[in] M
                     81: *> \verbatim
                     82: *>          M is INTEGER
                     83: *>          The number of rows of the matrix C.
                     84: *> \endverbatim
                     85: *>
                     86: *> \param[in] N
                     87: *> \verbatim
                     88: *>          N is INTEGER
                     89: *>          The number of columns of the matrix C.
                     90: *> \endverbatim
                     91: *>
                     92: *> \param[in] K
                     93: *> \verbatim
                     94: *>          K is INTEGER
                     95: *>          The order of the matrix T (= the number of elementary
                     96: *>          reflectors whose product defines the block reflector).
                     97: *> \endverbatim
                     98: *>
                     99: *> \param[in] L
                    100: *> \verbatim
                    101: *>          L is INTEGER
                    102: *>          The number of columns of the matrix V containing the
                    103: *>          meaningful part of the Householder reflectors.
                    104: *>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
                    105: *> \endverbatim
                    106: *>
                    107: *> \param[in] V
                    108: *> \verbatim
                    109: *>          V is COMPLEX*16 array, dimension (LDV,NV).
                    110: *>          If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
                    111: *> \endverbatim
                    112: *>
                    113: *> \param[in] LDV
                    114: *> \verbatim
                    115: *>          LDV is INTEGER
                    116: *>          The leading dimension of the array V.
                    117: *>          If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
                    118: *> \endverbatim
                    119: *>
                    120: *> \param[in] T
                    121: *> \verbatim
                    122: *>          T is COMPLEX*16 array, dimension (LDT,K)
                    123: *>          The triangular K-by-K matrix T in the representation of the
                    124: *>          block reflector.
                    125: *> \endverbatim
                    126: *>
                    127: *> \param[in] LDT
                    128: *> \verbatim
                    129: *>          LDT is INTEGER
                    130: *>          The leading dimension of the array T. LDT >= K.
                    131: *> \endverbatim
                    132: *>
                    133: *> \param[in,out] C
                    134: *> \verbatim
                    135: *>          C is COMPLEX*16 array, dimension (LDC,N)
                    136: *>          On entry, the M-by-N matrix C.
                    137: *>          On exit, C is overwritten by H*C or H**H*C or C*H or C*H**H.
                    138: *> \endverbatim
                    139: *>
                    140: *> \param[in] LDC
                    141: *> \verbatim
                    142: *>          LDC is INTEGER
                    143: *>          The leading dimension of the array C. LDC >= max(1,M).
                    144: *> \endverbatim
                    145: *>
                    146: *> \param[out] WORK
                    147: *> \verbatim
                    148: *>          WORK is COMPLEX*16 array, dimension (LDWORK,K)
                    149: *> \endverbatim
                    150: *>
                    151: *> \param[in] LDWORK
                    152: *> \verbatim
                    153: *>          LDWORK is INTEGER
                    154: *>          The leading dimension of the array WORK.
                    155: *>          If SIDE = 'L', LDWORK >= max(1,N);
                    156: *>          if SIDE = 'R', LDWORK >= max(1,M).
                    157: *> \endverbatim
                    158: *
                    159: *  Authors:
                    160: *  ========
                    161: *
                    162: *> \author Univ. of Tennessee 
                    163: *> \author Univ. of California Berkeley 
                    164: *> \author Univ. of Colorado Denver 
                    165: *> \author NAG Ltd. 
                    166: *
                    167: *> \date November 2011
                    168: *
                    169: *> \ingroup complex16OTHERcomputational
                    170: *
                    171: *> \par Contributors:
                    172: *  ==================
                    173: *>
                    174: *>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
                    175: *
                    176: *> \par Further Details:
                    177: *  =====================
                    178: *>
                    179: *> \verbatim
                    180: *> \endverbatim
                    181: *>
                    182: *  =====================================================================
1.1       bertrand  183:       SUBROUTINE ZLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
                    184:      $                   LDV, T, LDT, C, LDC, WORK, LDWORK )
                    185: *
1.9       bertrand  186: *  -- LAPACK computational routine (version 3.4.0) --
1.1       bertrand  187: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    188: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9       bertrand  189: *     November 2011
1.1       bertrand  190: *
                    191: *     .. Scalar Arguments ..
                    192:       CHARACTER          DIRECT, SIDE, STOREV, TRANS
                    193:       INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
                    194: *     ..
                    195: *     .. Array Arguments ..
                    196:       COMPLEX*16         C( LDC, * ), T( LDT, * ), V( LDV, * ),
                    197:      $                   WORK( LDWORK, * )
                    198: *     ..
                    199: *
                    200: *  =====================================================================
                    201: *
                    202: *     .. Parameters ..
                    203:       COMPLEX*16         ONE
                    204:       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
                    205: *     ..
                    206: *     .. Local Scalars ..
                    207:       CHARACTER          TRANST
                    208:       INTEGER            I, INFO, J
                    209: *     ..
                    210: *     .. External Functions ..
                    211:       LOGICAL            LSAME
                    212:       EXTERNAL           LSAME
                    213: *     ..
                    214: *     .. External Subroutines ..
                    215:       EXTERNAL           XERBLA, ZCOPY, ZGEMM, ZLACGV, ZTRMM
                    216: *     ..
                    217: *     .. Executable Statements ..
                    218: *
                    219: *     Quick return if possible
                    220: *
                    221:       IF( M.LE.0 .OR. N.LE.0 )
                    222:      $   RETURN
                    223: *
                    224: *     Check for currently supported options
                    225: *
                    226:       INFO = 0
                    227:       IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
                    228:          INFO = -3
                    229:       ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
                    230:          INFO = -4
                    231:       END IF
                    232:       IF( INFO.NE.0 ) THEN
                    233:          CALL XERBLA( 'ZLARZB', -INFO )
                    234:          RETURN
                    235:       END IF
                    236: *
                    237:       IF( LSAME( TRANS, 'N' ) ) THEN
                    238:          TRANST = 'C'
                    239:       ELSE
                    240:          TRANST = 'N'
                    241:       END IF
                    242: *
                    243:       IF( LSAME( SIDE, 'L' ) ) THEN
                    244: *
1.8       bertrand  245: *        Form  H * C  or  H**H * C
1.1       bertrand  246: *
1.8       bertrand  247: *        W( 1:n, 1:k ) = C( 1:k, 1:n )**H
1.1       bertrand  248: *
                    249:          DO 10 J = 1, K
                    250:             CALL ZCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
                    251:    10    CONTINUE
                    252: *
                    253: *        W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
1.8       bertrand  254: *                        C( m-l+1:m, 1:n )**H * V( 1:k, 1:l )**T
1.1       bertrand  255: *
                    256:          IF( L.GT.0 )
                    257:      $      CALL ZGEMM( 'Transpose', 'Conjugate transpose', N, K, L,
                    258:      $                  ONE, C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK,
                    259:      $                  LDWORK )
                    260: *
1.8       bertrand  261: *        W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T  or  W( 1:m, 1:k ) * T
1.1       bertrand  262: *
                    263:          CALL ZTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
                    264:      $               LDT, WORK, LDWORK )
                    265: *
1.8       bertrand  266: *        C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**H
1.1       bertrand  267: *
                    268:          DO 30 J = 1, N
                    269:             DO 20 I = 1, K
                    270:                C( I, J ) = C( I, J ) - WORK( J, I )
                    271:    20       CONTINUE
                    272:    30    CONTINUE
                    273: *
                    274: *        C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
1.8       bertrand  275: *                            V( 1:k, 1:l )**H * W( 1:n, 1:k )**H
1.1       bertrand  276: *
                    277:          IF( L.GT.0 )
                    278:      $      CALL ZGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
                    279:      $                  WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC )
                    280: *
                    281:       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
                    282: *
1.8       bertrand  283: *        Form  C * H  or  C * H**H
1.1       bertrand  284: *
                    285: *        W( 1:m, 1:k ) = C( 1:m, 1:k )
                    286: *
                    287:          DO 40 J = 1, K
                    288:             CALL ZCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
                    289:    40    CONTINUE
                    290: *
                    291: *        W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
1.8       bertrand  292: *                        C( 1:m, n-l+1:n ) * V( 1:k, 1:l )**H
1.1       bertrand  293: *
                    294:          IF( L.GT.0 )
                    295:      $      CALL ZGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
                    296:      $                  C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
                    297: *
                    298: *        W( 1:m, 1:k ) = W( 1:m, 1:k ) * conjg( T )  or
1.8       bertrand  299: *                        W( 1:m, 1:k ) * T**H
1.1       bertrand  300: *
                    301:          DO 50 J = 1, K
                    302:             CALL ZLACGV( K-J+1, T( J, J ), 1 )
                    303:    50    CONTINUE
                    304:          CALL ZTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
                    305:      $               LDT, WORK, LDWORK )
                    306:          DO 60 J = 1, K
                    307:             CALL ZLACGV( K-J+1, T( J, J ), 1 )
                    308:    60    CONTINUE
                    309: *
                    310: *        C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k )
                    311: *
                    312:          DO 80 J = 1, K
                    313:             DO 70 I = 1, M
                    314:                C( I, J ) = C( I, J ) - WORK( I, J )
                    315:    70       CONTINUE
                    316:    80    CONTINUE
                    317: *
                    318: *        C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
                    319: *                            W( 1:m, 1:k ) * conjg( V( 1:k, 1:l ) )
                    320: *
                    321:          DO 90 J = 1, L
                    322:             CALL ZLACGV( K, V( 1, J ), 1 )
                    323:    90    CONTINUE
                    324:          IF( L.GT.0 )
                    325:      $      CALL ZGEMM( 'No transpose', 'No transpose', M, L, K, -ONE,
                    326:      $                  WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC )
                    327:          DO 100 J = 1, L
                    328:             CALL ZLACGV( K, V( 1, J ), 1 )
                    329:   100    CONTINUE
                    330: *
                    331:       END IF
                    332: *
                    333:       RETURN
                    334: *
                    335: *     End of ZLARZB
                    336: *
                    337:       END

CVSweb interface <joel.bertrand@systella.fr>