001:       SUBROUTINE ZLACRM( M, N, A, LDA, B, LDB, C, LDC, RWORK )
002: *
003: *  -- LAPACK auxiliary routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            LDA, LDB, LDC, M, N
010: *     ..
011: *     .. Array Arguments ..
012:       DOUBLE PRECISION   B( LDB, * ), RWORK( * )
013:       COMPLEX*16         A( LDA, * ), C( LDC, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  ZLACRM performs a very simple matrix-matrix multiplication:
020: *           C := A * B,
021: *  where A is M by N and complex; B is N by N and real;
022: *  C is M by N and complex.
023: *
024: *  Arguments
025: *  =========
026: *
027: *  M       (input) INTEGER
028: *          The number of rows of the matrix A and of the matrix C.
029: *          M >= 0.
030: *
031: *  N       (input) INTEGER
032: *          The number of columns and rows of the matrix B and
033: *          the number of columns of the matrix C.
034: *          N >= 0.
035: *
036: *  A       (input) COMPLEX*16 array, dimension (LDA, N)
037: *          A contains the M by N matrix A.
038: *
039: *  LDA     (input) INTEGER
040: *          The leading dimension of the array A. LDA >=max(1,M).
041: *
042: *  B       (input) DOUBLE PRECISION array, dimension (LDB, N)
043: *          B contains the N by N matrix B.
044: *
045: *  LDB     (input) INTEGER
046: *          The leading dimension of the array B. LDB >=max(1,N).
047: *
048: *  C       (input) COMPLEX*16 array, dimension (LDC, N)
049: *          C contains the M by N matrix C.
050: *
051: *  LDC     (input) INTEGER
052: *          The leading dimension of the array C. LDC >=max(1,N).
053: *
054: *  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*M*N)
055: *
056: *  =====================================================================
057: *
058: *     .. Parameters ..
059:       DOUBLE PRECISION   ONE, ZERO
060:       PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0 )
061: *     ..
062: *     .. Local Scalars ..
063:       INTEGER            I, J, L
064: *     ..
065: *     .. Intrinsic Functions ..
066:       INTRINSIC          DBLE, DCMPLX, DIMAG
067: *     ..
068: *     .. External Subroutines ..
069:       EXTERNAL           DGEMM
070: *     ..
071: *     .. Executable Statements ..
072: *
073: *     Quick return if possible.
074: *
075:       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
076:      $   RETURN
077: *
078:       DO 20 J = 1, N
079:          DO 10 I = 1, M
080:             RWORK( ( J-1 )*M+I ) = DBLE( A( I, J ) )
081:    10    CONTINUE
082:    20 CONTINUE
083: *
084:       L = M*N + 1
085:       CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO,
086:      $            RWORK( L ), M )
087:       DO 40 J = 1, N
088:          DO 30 I = 1, M
089:             C( I, J ) = RWORK( L+( J-1 )*M+I-1 )
090:    30    CONTINUE
091:    40 CONTINUE
092: *
093:       DO 60 J = 1, N
094:          DO 50 I = 1, M
095:             RWORK( ( J-1 )*M+I ) = DIMAG( A( I, J ) )
096:    50    CONTINUE
097:    60 CONTINUE
098:       CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO,
099:      $            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 ZLACRM
110: *
111:       END
112: