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

1.12      bertrand    1: *> \brief \b DORMR2 multiplies a general matrix by the orthogonal matrix from a RQ factorization determined by sgerqf (unblocked algorithm).
1.9       bertrand    2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.16      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.9       bertrand    7: *
                      8: *> \htmlonly
1.16      bertrand    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">
1.9       bertrand   15: *> [TXT]</a>
1.16      bertrand   16: *> \endhtmlonly
1.9       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
                     22: *                          WORK, INFO )
1.16      bertrand   23: *
1.9       bertrand   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: *       ..
1.16      bertrand   31: *
1.9       bertrand   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: *
1.16      bertrand  149: *> \author Univ. of Tennessee
                    150: *> \author Univ. of California Berkeley
                    151: *> \author Univ. of Colorado Denver
                    152: *> \author NAG Ltd.
1.9       bertrand  153: *
                    154: *> \ingroup doubleOTHERcomputational
                    155: *
                    156: *  =====================================================================
1.1       bertrand  157:       SUBROUTINE DORMR2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
                    158:      $                   WORK, INFO )
                    159: *
1.19    ! bertrand  160: *  -- LAPACK computational routine --
1.1       bertrand  161: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    162: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
                    163: *
                    164: *     .. Scalar Arguments ..
                    165:       CHARACTER          SIDE, TRANS
                    166:       INTEGER            INFO, K, LDA, LDC, M, N
                    167: *     ..
                    168: *     .. Array Arguments ..
                    169:       DOUBLE PRECISION   A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
                    170: *     ..
                    171: *
                    172: *  =====================================================================
                    173: *
                    174: *     .. Parameters ..
                    175:       DOUBLE PRECISION   ONE
                    176:       PARAMETER          ( ONE = 1.0D+0 )
                    177: *     ..
                    178: *     .. Local Scalars ..
                    179:       LOGICAL            LEFT, NOTRAN
                    180:       INTEGER            I, I1, I2, I3, MI, NI, NQ
                    181:       DOUBLE PRECISION   AII
                    182: *     ..
                    183: *     .. External Functions ..
                    184:       LOGICAL            LSAME
                    185:       EXTERNAL           LSAME
                    186: *     ..
                    187: *     .. External Subroutines ..
                    188:       EXTERNAL           DLARF, XERBLA
                    189: *     ..
                    190: *     .. Intrinsic Functions ..
                    191:       INTRINSIC          MAX
                    192: *     ..
                    193: *     .. Executable Statements ..
                    194: *
                    195: *     Test the input arguments
                    196: *
                    197:       INFO = 0
                    198:       LEFT = LSAME( SIDE, 'L' )
                    199:       NOTRAN = LSAME( TRANS, 'N' )
                    200: *
                    201: *     NQ is the order of Q
                    202: *
                    203:       IF( LEFT ) THEN
                    204:          NQ = M
                    205:       ELSE
                    206:          NQ = N
                    207:       END IF
                    208:       IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
                    209:          INFO = -1
                    210:       ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
                    211:          INFO = -2
                    212:       ELSE IF( M.LT.0 ) THEN
                    213:          INFO = -3
                    214:       ELSE IF( N.LT.0 ) THEN
                    215:          INFO = -4
                    216:       ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
                    217:          INFO = -5
                    218:       ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
                    219:          INFO = -7
                    220:       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
                    221:          INFO = -10
                    222:       END IF
                    223:       IF( INFO.NE.0 ) THEN
                    224:          CALL XERBLA( 'DORMR2', -INFO )
                    225:          RETURN
                    226:       END IF
                    227: *
                    228: *     Quick return if possible
                    229: *
                    230:       IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
                    231:      $   RETURN
                    232: *
                    233:       IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
                    234:      $     THEN
                    235:          I1 = 1
                    236:          I2 = K
                    237:          I3 = 1
                    238:       ELSE
                    239:          I1 = K
                    240:          I2 = 1
                    241:          I3 = -1
                    242:       END IF
                    243: *
                    244:       IF( LEFT ) THEN
                    245:          NI = N
                    246:       ELSE
                    247:          MI = M
                    248:       END IF
                    249: *
                    250:       DO 10 I = I1, I2, I3
                    251:          IF( LEFT ) THEN
                    252: *
                    253: *           H(i) is applied to C(1:m-k+i,1:n)
                    254: *
                    255:             MI = M - K + I
                    256:          ELSE
                    257: *
                    258: *           H(i) is applied to C(1:m,1:n-k+i)
                    259: *
                    260:             NI = N - K + I
                    261:          END IF
                    262: *
                    263: *        Apply H(i)
                    264: *
                    265:          AII = A( I, NQ-K+I )
                    266:          A( I, NQ-K+I ) = ONE
                    267:          CALL DLARF( SIDE, MI, NI, A( I, 1 ), LDA, TAU( I ), C, LDC,
                    268:      $               WORK )
                    269:          A( I, NQ-K+I ) = AII
                    270:    10 CONTINUE
                    271:       RETURN
                    272: *
                    273: *     End of DORMR2
                    274: *
                    275:       END

CVSweb interface <joel.bertrand@systella.fr>