1: SUBROUTINE ZLACRM( 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 B( LDB, * ), RWORK( * )
13: COMPLEX*16 A( LDA, * ), C( LDC, * )
14: * ..
15: *
16: * Purpose
17: * =======
18: *
19: * ZLACRM performs a very simple matrix-matrix multiplication:
20: * C := A * B,
21: * where A is M by N and complex; B is N by N and real;
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) COMPLEX*16 array, dimension (LDA, N)
37: * A contains the M by N 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 N by N matrix B.
44: *
45: * LDB (input) INTEGER
46: * The leading dimension of the array B. LDB >=max(1,N).
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,N).
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( A( I, J ) )
81: 10 CONTINUE
82: 20 CONTINUE
83: *
84: L = M*N + 1
85: CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, 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( A( I, J ) )
96: 50 CONTINUE
97: 60 CONTINUE
98: CALL DGEMM( 'N', 'N', M, N, N, ONE, RWORK, M, B, LDB, 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 ZLACRM
110: *
111: END
CVSweb interface <joel.bertrand@systella.fr>