1*> \brief \b ZLACRM multiplies a complex matrix by a square real matrix.
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZLACRM + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlacrm.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlacrm.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlacrm.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE ZLACRM( M, N, A, LDA, B, LDB, C, LDC, RWORK )
22*
23*       .. Scalar Arguments ..
24*       INTEGER            LDA, LDB, LDC, M, N
25*       ..
26*       .. Array Arguments ..
27*       DOUBLE PRECISION   B( LDB, * ), RWORK( * )
28*       COMPLEX*16         A( LDA, * ), C( LDC, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> ZLACRM performs a very simple matrix-matrix multiplication:
38*>          C := A * B,
39*> where A is M by N and complex; B is N by N and real;
40*> C is M by N and complex.
41*> \endverbatim
42*
43*  Arguments:
44*  ==========
45*
46*> \param[in] M
47*> \verbatim
48*>          M is INTEGER
49*>          The number of rows of the matrix A and of the matrix C.
50*>          M >= 0.
51*> \endverbatim
52*>
53*> \param[in] N
54*> \verbatim
55*>          N is INTEGER
56*>          The number of columns and rows of the matrix B and
57*>          the number of columns of the matrix C.
58*>          N >= 0.
59*> \endverbatim
60*>
61*> \param[in] A
62*> \verbatim
63*>          A is COMPLEX*16 array, dimension (LDA, N)
64*>          On entry, A contains the M by N matrix A.
65*> \endverbatim
66*>
67*> \param[in] LDA
68*> \verbatim
69*>          LDA is INTEGER
70*>          The leading dimension of the array A. LDA >=max(1,M).
71*> \endverbatim
72*>
73*> \param[in] B
74*> \verbatim
75*>          B is DOUBLE PRECISION array, dimension (LDB, N)
76*>          On entry, B contains the N by N matrix B.
77*> \endverbatim
78*>
79*> \param[in] LDB
80*> \verbatim
81*>          LDB is INTEGER
82*>          The leading dimension of the array B. LDB >=max(1,N).
83*> \endverbatim
84*>
85*> \param[out] C
86*> \verbatim
87*>          C is COMPLEX*16 array, dimension (LDC, N)
88*>          On exit, C contains the M by N matrix C.
89*> \endverbatim
90*>
91*> \param[in] LDC
92*> \verbatim
93*>          LDC is INTEGER
94*>          The leading dimension of the array C. LDC >=max(1,N).
95*> \endverbatim
96*>
97*> \param[out] RWORK
98*> \verbatim
99*>          RWORK is DOUBLE PRECISION array, dimension (2*M*N)
100*> \endverbatim
101*
102*  Authors:
103*  ========
104*
105*> \author Univ. of Tennessee
106*> \author Univ. of California Berkeley
107*> \author Univ. of Colorado Denver
108*> \author NAG Ltd.
109*
110*> \ingroup complex16OTHERauxiliary
111*
112*  =====================================================================
113      SUBROUTINE ZLACRM( M, N, A, LDA, B, LDB, C, LDC, RWORK )
114*
115*  -- LAPACK auxiliary routine --
116*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
117*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
118*
119*     .. Scalar Arguments ..
120      INTEGER            LDA, LDB, LDC, M, N
121*     ..
122*     .. Array Arguments ..
123      DOUBLE PRECISION   B( LDB, * ), RWORK( * )
124      COMPLEX*16         A( LDA, * ), C( LDC, * )
125*     ..
126*
127*  =====================================================================
128*
129*     .. Parameters ..
130      DOUBLE PRECISION   ONE, ZERO
131      PARAMETER          ( ONE = 1.0D0, ZERO = 0.0D0 )
132*     ..
133*     .. Local Scalars ..
134      INTEGER            I, J, L
135*     ..
136*     .. Intrinsic Functions ..
137      INTRINSIC          DBLE, DCMPLX, DIMAG
138*     ..
139*     .. External Subroutines ..
140      EXTERNAL           DGEMM
141*     ..
142*     .. Executable Statements ..
143*
144*     Quick return if possible.
145*
146      IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
147     $   RETURN
148*
149      DO 20 J = 1, N
150         DO 10 I = 1, M
151            RWORK( ( J-1 )*M+I ) = DBLE( A( I, J ) )
152   10    CONTINUE
153   20 CONTINUE
154*
155      L = M*N + 1
156      CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO,
157     $            RWORK( L ), M )
158      DO 40 J = 1, N
159         DO 30 I = 1, M
160            C( I, J ) = RWORK( L+( J-1 )*M+I-1 )
161   30    CONTINUE
162   40 CONTINUE
163*
164      DO 60 J = 1, N
165         DO 50 I = 1, M
166            RWORK( ( J-1 )*M+I ) = DIMAG( A( I, J ) )
167   50    CONTINUE
168   60 CONTINUE
169      CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, ZERO,
170     $            RWORK( L ), M )
171      DO 80 J = 1, N
172         DO 70 I = 1, M
173            C( I, J ) = DCMPLX( DBLE( C( I, J ) ),
174     $                  RWORK( L+( J-1 )*M+I-1 ) )
175   70    CONTINUE
176   80 CONTINUE
177*
178      RETURN
179*
180*     End of ZLACRM
181*
182      END
183