LAPACK: SRC/zunml2.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZUNML2( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
00002      $                   WORK, INFO )
00003 *
00004 *  -- LAPACK routine (version 3.2) --
00005 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00006 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       CHARACTER          SIDE, TRANS
00011       INTEGER            INFO, K, LDA, LDC, M, N
00012 *     ..
00013 *     .. Array Arguments ..
00014       COMPLEX*16         A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  ZUNML2 overwrites the general complex m-by-n matrix C with
00021 *
00022 *        Q * C  if SIDE = 'L' and TRANS = 'N', or
00023 *
00024 *        Q'* C  if SIDE = 'L' and TRANS = 'C', or
00025 *
00026 *        C * Q  if SIDE = 'R' and TRANS = 'N', or
00027 *
00028 *        C * Q' if SIDE = 'R' and TRANS = 'C',
00029 *
00030 *  where Q is a complex unitary matrix defined as the product of k
00031 *  elementary reflectors
00032 *
00033 *        Q = H(k)' . . . H(2)' H(1)'
00034 *
00035 *  as returned by ZGELQF. Q is of order m if SIDE = 'L' and of order n
00036 *  if SIDE = 'R'.
00037 *
00038 *  Arguments
00039 *  =========
00040 *
00041 *  SIDE    (input) CHARACTER*1
00042 *          = 'L': apply Q or Q' from the Left
00043 *          = 'R': apply Q or Q' from the Right
00044 *
00045 *  TRANS   (input) CHARACTER*1
00046 *          = 'N': apply Q  (No transpose)
00047 *          = 'C': apply Q' (Conjugate transpose)
00048 *
00049 *  M       (input) INTEGER
00050 *          The number of rows of the matrix C. M >= 0.
00051 *
00052 *  N       (input) INTEGER
00053 *          The number of columns of the matrix C. N >= 0.
00054 *
00055 *  K       (input) INTEGER
00056 *          The number of elementary reflectors whose product defines
00057 *          the matrix Q.
00058 *          If SIDE = 'L', M >= K >= 0;
00059 *          if SIDE = 'R', N >= K >= 0.
00060 *
00061 *  A       (input) COMPLEX*16 array, dimension
00062 *                               (LDA,M) if SIDE = 'L',
00063 *                               (LDA,N) if SIDE = 'R'
00064 *          The i-th row must contain the vector which defines the
00065 *          elementary reflector H(i), for i = 1,2,...,k, as returned by
00066 *          ZGELQF in the first k rows of its array argument A.
00067 *          A is modified by the routine but restored on exit.
00068 *
00069 *  LDA     (input) INTEGER
00070 *          The leading dimension of the array A. LDA >= max(1,K).
00071 *
00072 *  TAU     (input) COMPLEX*16 array, dimension (K)
00073 *          TAU(i) must contain the scalar factor of the elementary
00074 *          reflector H(i), as returned by ZGELQF.
00075 *
00076 *  C       (input/output) COMPLEX*16 array, dimension (LDC,N)
00077 *          On entry, the m-by-n matrix C.
00078 *          On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
00079 *
00080 *  LDC     (input) INTEGER
00081 *          The leading dimension of the array C. LDC >= max(1,M).
00082 *
00083 *  WORK    (workspace) COMPLEX*16 array, dimension
00084 *                                   (N) if SIDE = 'L',
00085 *                                   (M) if SIDE = 'R'
00086 *
00087 *  INFO    (output) INTEGER
00088 *          = 0: successful exit
00089 *          < 0: if INFO = -i, the i-th argument had an illegal value
00090 *
00091 *  =====================================================================
00092 *
00093 *     .. Parameters ..
00094       COMPLEX*16         ONE
00095       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
00096 *     ..
00097 *     .. Local Scalars ..
00098       LOGICAL            LEFT, NOTRAN
00099       INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
00100       COMPLEX*16         AII, TAUI
00101 *     ..
00102 *     .. External Functions ..
00103       LOGICAL            LSAME
00104       EXTERNAL           LSAME
00105 *     ..
00106 *     .. External Subroutines ..
00107       EXTERNAL           XERBLA, ZLACGV, ZLARF
00108 *     ..
00109 *     .. Intrinsic Functions ..
00110       INTRINSIC          DCONJG, MAX
00111 *     ..
00112 *     .. Executable Statements ..
00113 *
00114 *     Test the input arguments
00115 *
00116       INFO = 0
00117       LEFT = LSAME( SIDE, 'L' )
00118       NOTRAN = LSAME( TRANS, 'N' )
00119 *
00120 *     NQ is the order of Q
00121 *
00122       IF( LEFT ) THEN
00123          NQ = M
00124       ELSE
00125          NQ = N
00126       END IF
00127       IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
00128          INFO = -1
00129       ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
00130          INFO = -2
00131       ELSE IF( M.LT.0 ) THEN
00132          INFO = -3
00133       ELSE IF( N.LT.0 ) THEN
00134          INFO = -4
00135       ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
00136          INFO = -5
00137       ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
00138          INFO = -7
00139       ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
00140          INFO = -10
00141       END IF
00142       IF( INFO.NE.0 ) THEN
00143          CALL XERBLA( 'ZUNML2', -INFO )
00144          RETURN
00145       END IF
00146 *
00147 *     Quick return if possible
00148 *
00149       IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
00150      $   RETURN
00151 *
00152       IF( ( LEFT .AND. NOTRAN .OR. .NOT.LEFT .AND. .NOT.NOTRAN ) ) THEN
00153          I1 = 1
00154          I2 = K
00155          I3 = 1
00156       ELSE
00157          I1 = K
00158          I2 = 1
00159          I3 = -1
00160       END IF
00161 *
00162       IF( LEFT ) THEN
00163          NI = N
00164          JC = 1
00165       ELSE
00166          MI = M
00167          IC = 1
00168       END IF
00169 *
00170       DO 10 I = I1, I2, I3
00171          IF( LEFT ) THEN
00172 *
00173 *           H(i) or H(i)' is applied to C(i:m,1:n)
00174 *
00175             MI = M - I + 1
00176             IC = I
00177          ELSE
00178 *
00179 *           H(i) or H(i)' is applied to C(1:m,i:n)
00180 *
00181             NI = N - I + 1
00182             JC = I
00183          END IF
00184 *
00185 *        Apply H(i) or H(i)'
00186 *
00187          IF( NOTRAN ) THEN
00188             TAUI = DCONJG( TAU( I ) )
00189          ELSE
00190             TAUI = TAU( I )
00191          END IF
00192          IF( I.LT.NQ )
00193      $      CALL ZLACGV( NQ-I, A( I, I+1 ), LDA )
00194          AII = A( I, I )
00195          A( I, I ) = ONE
00196          CALL ZLARF( SIDE, MI, NI, A( I, I ), LDA, TAUI, C( IC, JC ),
00197      $               LDC, WORK )
00198          A( I, I ) = AII
00199          IF( I.LT.NQ )
00200      $      CALL ZLACGV( NQ-I, A( I, I+1 ), LDA )
00201    10 CONTINUE
00202       RETURN
00203 *
00204 *     End of ZUNML2
00205 *
00206       END