File:  [local] / rpl / lapack / lapack / zlarcm.f
Revision 1.5: download - view: text, annotated - select for diffs - revision graph
Sat Aug 7 13:22:40 2010 UTC (13 years, 9 months ago) by bertrand
Branches: MAIN
CVS tags: HEAD
Mise à jour globale de Lapack 3.2.2.

    1:       SUBROUTINE ZLARCM( M, N, A, LDA, B, LDB, C, LDC, RWORK )
    2: *
    3: *  -- LAPACK auxiliary routine (version 3.2) --
    4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
    5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
    6: *     November 2006
    7: *
    8: *     .. Scalar Arguments ..
    9:       INTEGER            LDA, LDB, LDC, M, N
   10: *     ..
   11: *     .. Array Arguments ..
   12:       DOUBLE PRECISION   A( LDA, * ), RWORK( * )
   13:       COMPLEX*16         B( LDB, * ), C( LDC, * )
   14: *     ..
   15: *
   16: *  Purpose
   17: *  =======
   18: *
   19: *  ZLARCM performs a very simple matrix-matrix multiplication:
   20: *           C := A * B,
   21: *  where A is M by M and real; B is M by N and complex;
   22: *  C is M by N and complex.
   23: *
   24: *  Arguments
   25: *  =========
   26: *
   27: *  M       (input) INTEGER
   28: *          The number of rows of the matrix A and of the matrix C.
   29: *          M >= 0.
   30: *
   31: *  N       (input) INTEGER
   32: *          The number of columns and rows of the matrix B and
   33: *          the number of columns of the matrix C.
   34: *          N >= 0.
   35: *
   36: *  A       (input) DOUBLE PRECISION array, dimension (LDA, M)
   37: *          A contains the M by M matrix A.
   38: *
   39: *  LDA     (input) INTEGER
   40: *          The leading dimension of the array A. LDA >=max(1,M).
   41: *
   42: *  B       (input) DOUBLE PRECISION array, dimension (LDB, N)
   43: *          B contains the M by N matrix B.
   44: *
   45: *  LDB     (input) INTEGER
   46: *          The leading dimension of the array B. LDB >=max(1,M).
   47: *
   48: *  C       (input) COMPLEX*16 array, dimension (LDC, N)
   49: *          C contains the M by N matrix C.
   50: *
   51: *  LDC     (input) INTEGER
   52: *          The leading dimension of the array C. LDC >=max(1,M).
   53: *
   54: *  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*M*N)
   55: *
   56: *  =====================================================================
   57: *
   58: *     .. Parameters ..
   59:       DOUBLE PRECISION   ONE, ZERO
   60:       PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0 )
   61: *     ..
   62: *     .. Local Scalars ..
   63:       INTEGER            I, J, L
   64: *     ..
   65: *     .. Intrinsic Functions ..
   66:       INTRINSIC          DBLE, DCMPLX, DIMAG
   67: *     ..
   68: *     .. External Subroutines ..
   69:       EXTERNAL           DGEMM
   70: *     ..
   71: *     .. Executable Statements ..
   72: *
   73: *     Quick return if possible.
   74: *
   75:       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
   76:      $   RETURN
   77: *
   78:       DO 20 J = 1, N
   79:          DO 10 I = 1, M
   80:             RWORK( ( J-1 )*M+I ) = DBLE( B( I, J ) )
   81:    10    CONTINUE
   82:    20 CONTINUE
   83: *
   84:       L = M*N + 1
   85:       CALL DGEMM( 'N', 'N', M, N, M, ONE, A, LDA, RWORK, M, ZERO,
   86:      $            RWORK( L ), M )
   87:       DO 40 J = 1, N
   88:          DO 30 I = 1, M
   89:             C( I, J ) = RWORK( L+( J-1 )*M+I-1 )
   90:    30    CONTINUE
   91:    40 CONTINUE
   92: *
   93:       DO 60 J = 1, N
   94:          DO 50 I = 1, M
   95:             RWORK( ( J-1 )*M+I ) = DIMAG( B( I, J ) )
   96:    50    CONTINUE
   97:    60 CONTINUE
   98:       CALL DGEMM( 'N', 'N', M, N, M, ONE, A, LDA, RWORK, M, ZERO,
   99:      $            RWORK( L ), M )
  100:       DO 80 J = 1, N
  101:          DO 70 I = 1, M
  102:             C( I, J ) = DCMPLX( DBLE( C( I, J ) ),
  103:      $                  RWORK( L+( J-1 )*M+I-1 ) )
  104:    70    CONTINUE
  105:    80 CONTINUE
  106: *
  107:       RETURN
  108: *
  109: *     End of ZLARCM
  110: *
  111:       END

CVSweb interface <joel.bertrand@systella.fr>