File:
[local] /
rpl /
lapack /
lapack /
zlarcm.f
Revision
1.7:
download - view:
text,
annotated -
select for diffs -
revision graph
Tue Dec 21 13:53:51 2010 UTC (13 years, 6 months ago) by
bertrand
Branches:
MAIN
CVS tags:
rpl-4_1_3,
rpl-4_1_2,
rpl-4_1_1,
rpl-4_1_0,
rpl-4_0_24,
rpl-4_0_22,
rpl-4_0_21,
rpl-4_0_20,
rpl-4_0,
HEAD
Mise à jour de lapack vers la version 3.3.0.
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>