Annotation of rpl/lapack/lapack/dormr2.f, revision 1.9

1.9     ! bertrand    1: *> \brief \b DORMR2
        !             2: *
        !             3: *  =========== DOCUMENTATION ===========
        !             4: *
        !             5: * Online html documentation available at 
        !             6: *            http://www.netlib.org/lapack/explore-html/ 
        !             7: *
        !             8: *> \htmlonly
        !             9: *> Download DORMR2 + dependencies 
        !            10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormr2.f"> 
        !            11: *> [TGZ]</a> 
        !            12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormr2.f"> 
        !            13: *> [ZIP]</a> 
        !            14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormr2.f"> 
        !            15: *> [TXT]</a>
        !            16: *> \endhtmlonly 
        !            17: *
        !            18: *  Definition:
        !            19: *  ===========
        !            20: *
        !            21: *       SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
        !            22: *                          WORK, INFO )
        !            23: * 
        !            24: *       .. Scalar Arguments ..
        !            25: *       CHARACTER          SIDE, TRANS
        !            26: *       INTEGER            INFO, K, LDA, LDC, 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: *> DORMR2 overwrites the general real m by n matrix C with
        !            39: *>
        !            40: *>       Q * C  if SIDE = 'L' and TRANS = 'N', or
        !            41: *>
        !            42: *>       Q**T* C  if SIDE = 'L' and TRANS = 'T', or
        !            43: *>
        !            44: *>       C * Q  if SIDE = 'R' and TRANS = 'N', or
        !            45: *>
        !            46: *>       C * Q**T if SIDE = 'R' and TRANS = 'T',
        !            47: *>
        !            48: *> where Q is a real orthogonal matrix defined as the product of k
        !            49: *> elementary reflectors
        !            50: *>
        !            51: *>       Q = H(1) H(2) . . . H(k)
        !            52: *>
        !            53: *> as returned by DGERQF. Q is of order m if SIDE = 'L' and of order n
        !            54: *> if SIDE = 'R'.
        !            55: *> \endverbatim
        !            56: *
        !            57: *  Arguments:
        !            58: *  ==========
        !            59: *
        !            60: *> \param[in] SIDE
        !            61: *> \verbatim
        !            62: *>          SIDE is CHARACTER*1
        !            63: *>          = 'L': apply Q or Q**T from the Left
        !            64: *>          = 'R': apply Q or Q**T from the Right
        !            65: *> \endverbatim
        !            66: *>
        !            67: *> \param[in] TRANS
        !            68: *> \verbatim
        !            69: *>          TRANS is CHARACTER*1
        !            70: *>          = 'N': apply Q  (No transpose)
        !            71: *>          = 'T': apply Q' (Transpose)
        !            72: *> \endverbatim
        !            73: *>
        !            74: *> \param[in] M
        !            75: *> \verbatim
        !            76: *>          M is INTEGER
        !            77: *>          The number of rows of the matrix C. M >= 0.
        !            78: *> \endverbatim
        !            79: *>
        !            80: *> \param[in] N
        !            81: *> \verbatim
        !            82: *>          N is INTEGER
        !            83: *>          The number of columns of the matrix C. N >= 0.
        !            84: *> \endverbatim
        !            85: *>
        !            86: *> \param[in] K
        !            87: *> \verbatim
        !            88: *>          K is INTEGER
        !            89: *>          The number of elementary reflectors whose product defines
        !            90: *>          the matrix Q.
        !            91: *>          If SIDE = 'L', M >= K >= 0;
        !            92: *>          if SIDE = 'R', N >= K >= 0.
        !            93: *> \endverbatim
        !            94: *>
        !            95: *> \param[in] A
        !            96: *> \verbatim
        !            97: *>          A is DOUBLE PRECISION array, dimension
        !            98: *>                               (LDA,M) if SIDE = 'L',
        !            99: *>                               (LDA,N) if SIDE = 'R'
        !           100: *>          The i-th row must contain the vector which defines the
        !           101: *>          elementary reflector H(i), for i = 1,2,...,k, as returned by
        !           102: *>          DGERQF in the last k rows of its array argument A.
        !           103: *>          A is modified by the routine but restored on exit.
        !           104: *> \endverbatim
        !           105: *>
        !           106: *> \param[in] LDA
        !           107: *> \verbatim
        !           108: *>          LDA is INTEGER
        !           109: *>          The leading dimension of the array A. LDA >= max(1,K).
        !           110: *> \endverbatim
        !           111: *>
        !           112: *> \param[in] TAU
        !           113: *> \verbatim
        !           114: *>          TAU is DOUBLE PRECISION array, dimension (K)
        !           115: *>          TAU(i) must contain the scalar factor of the elementary
        !           116: *>          reflector H(i), as returned by DGERQF.
        !           117: *> \endverbatim
        !           118: *>
        !           119: *> \param[in,out] C
        !           120: *> \verbatim
        !           121: *>          C is DOUBLE PRECISION array, dimension (LDC,N)
        !           122: *>          On entry, the m by n matrix C.
        !           123: *>          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
        !           124: *> \endverbatim
        !           125: *>
        !           126: *> \param[in] LDC
        !           127: *> \verbatim
        !           128: *>          LDC is INTEGER
        !           129: *>          The leading dimension of the array C. LDC >= max(1,M).
        !           130: *> \endverbatim
        !           131: *>
        !           132: *> \param[out] WORK
        !           133: *> \verbatim
        !           134: *>          WORK is DOUBLE PRECISION array, dimension
        !           135: *>                                   (N) if SIDE = 'L',
        !           136: *>                                   (M) if SIDE = 'R'
        !           137: *> \endverbatim
        !           138: *>
        !           139: *> \param[out] INFO
        !           140: *> \verbatim
        !           141: *>          INFO is INTEGER
        !           142: *>          = 0: successful exit
        !           143: *>          < 0: if INFO = -i, the i-th argument had an illegal value
        !           144: *> \endverbatim
        !           145: *
        !           146: *  Authors:
        !           147: *  ========
        !           148: *
        !           149: *> \author Univ. of Tennessee 
        !           150: *> \author Univ. of California Berkeley 
        !           151: *> \author Univ. of Colorado Denver 
        !           152: *> \author NAG Ltd. 
        !           153: *
        !           154: *> \date November 2011
        !           155: *
        !           156: *> \ingroup doubleOTHERcomputational
        !           157: *
        !           158: *  =====================================================================
1.1       bertrand  159:       SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
                    160:      $                   WORK, INFO )
                    161: *
1.9     ! bertrand  162: *  -- LAPACK computational routine (version 3.4.0) --
1.1       bertrand  163: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    164: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.9     ! bertrand  165: *     November 2011
1.1       bertrand  166: *
                    167: *     .. Scalar Arguments ..
                    168:       CHARACTER          SIDE, TRANS
                    169:       INTEGER            INFO, K, LDA, LDC, M, N
                    170: *     ..
                    171: *     .. Array Arguments ..
                    172:       DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
                    173: *     ..
                    174: *
                    175: *  =====================================================================
                    176: *
                    177: *     .. Parameters ..
                    178:       DOUBLE PRECISION   ONE
                    179:       PARAMETER          ( ONE = 1.0D+0 )
                    180: *     ..
                    181: *     .. Local Scalars ..
                    182:       LOGICAL            LEFT, NOTRAN
                    183:       INTEGER            I, I1, I2, I3, MI, NI, NQ
                    184:       DOUBLE PRECISION   AII
                    185: *     ..
                    186: *     .. External Functions ..
                    187:       LOGICAL            LSAME
                    188:       EXTERNAL           LSAME
                    189: *     ..
                    190: *     .. External Subroutines ..
                    191:       EXTERNAL           DLARF, XERBLA
                    192: *     ..
                    193: *     .. Intrinsic Functions ..
                    194:       INTRINSIC          MAX
                    195: *     ..
                    196: *     .. Executable Statements ..
                    197: *
                    198: *     Test the input arguments
                    199: *
                    200:       INFO = 0
                    201:       LEFT = LSAME( SIDE, 'L' )
                    202:       NOTRAN = LSAME( TRANS, 'N' )
                    203: *
                    204: *     NQ is the order of Q
                    205: *
                    206:       IF( LEFT ) THEN
                    207:          NQ = M
                    208:       ELSE
                    209:          NQ = N
                    210:       END IF
                    211:       IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
                    212:          INFO = -1
                    213:       ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
                    214:          INFO = -2
                    215:       ELSE IF( M.LT.0 ) THEN
                    216:          INFO = -3
                    217:       ELSE IF( N.LT.0 ) THEN
                    218:          INFO = -4
                    219:       ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
                    220:          INFO = -5
                    221:       ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
                    222:          INFO = -7
                    223:       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
                    224:          INFO = -10
                    225:       END IF
                    226:       IF( INFO.NE.0 ) THEN
                    227:          CALL XERBLA( 'DORMR2', -INFO )
                    228:          RETURN
                    229:       END IF
                    230: *
                    231: *     Quick return if possible
                    232: *
                    233:       IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
                    234:      $   RETURN
                    235: *
                    236:       IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
                    237:      $     THEN
                    238:          I1 = 1
                    239:          I2 = K
                    240:          I3 = 1
                    241:       ELSE
                    242:          I1 = K
                    243:          I2 = 1
                    244:          I3 = -1
                    245:       END IF
                    246: *
                    247:       IF( LEFT ) THEN
                    248:          NI = N
                    249:       ELSE
                    250:          MI = M
                    251:       END IF
                    252: *
                    253:       DO 10 I = I1, I2, I3
                    254:          IF( LEFT ) THEN
                    255: *
                    256: *           H(i) is applied to C(1:m-k+i,1:n)
                    257: *
                    258:             MI = M - K + I
                    259:          ELSE
                    260: *
                    261: *           H(i) is applied to C(1:m,1:n-k+i)
                    262: *
                    263:             NI = N - K + I
                    264:          END IF
                    265: *
                    266: *        Apply H(i)
                    267: *
                    268:          AII = A( I, NQ-K+I )
                    269:          A( I, NQ-K+I ) = ONE
                    270:          CALL DLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC,
                    271:      $               WORK )
                    272:          A( I, NQ-K+I ) = AII
                    273:    10 CONTINUE
                    274:       RETURN
                    275: *
                    276: *     End of DORMR2
                    277: *
                    278:       END

CVSweb interface <joel.bertrand@systella.fr>