d7/d4c/clarcm_8f_source.html

00001       SUBROUTINE CLARCM( M, N, A, LDA, B, LDB, C, LDC, RWORK )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            LDA, LDB, LDC, M, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       REAL               A( LDA, * ), RWORK( * )
00013       COMPLEX            B( LDB, * ), C( LDC, * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  CLARCM performs a very simple matrix-matrix multiplication:
00020 *           C := A * B,
00021 *  where A is M by M and real; B is M by N and complex;
00022 *  C is M by N and complex.
00023 *
00024 *  Arguments
00025 *  =========
00026 *
00027 *  M       (input) INTEGER
00028 *          The number of rows of the matrix A and of the matrix C.
00029 *          M >= 0.
00030 *
00031 *  N       (input) INTEGER
00032 *          The number of columns and rows of the matrix B and
00033 *          the number of columns of the matrix C.
00034 *          N >= 0.
00035 *
00036 *  A       (input) REAL array, dimension (LDA, M)
00037 *          A contains the M by M matrix A.
00038 *
00039 *  LDA     (input) INTEGER
00040 *          The leading dimension of the array A. LDA >=max(1,M).
00041 *
00042 *  B       (input) REAL array, dimension (LDB, N)
00043 *          B contains the M by N matrix B.
00044 *
00045 *  LDB     (input) INTEGER
00046 *          The leading dimension of the array B. LDB >=max(1,M).
00047 *
00048 *  C       (input) COMPLEX array, dimension (LDC, N)
00049 *          C contains the M by N matrix C.
00050 *
00051 *  LDC     (input) INTEGER
00052 *          The leading dimension of the array C. LDC >=max(1,M).
00053 *
00054 *  RWORK   (workspace) REAL array, dimension (2*M*N)
00055 *
00056 *  =====================================================================
00057 *
00058 *     .. Parameters ..
00059       REAL               ONE, ZERO
00060       PARAMETER          ( ONE = 1.0E0, ZERO = 0.0E0 )
00061 *     ..
00062 *     .. Local Scalars ..
00063       INTEGER            I, J, L
00064 *     ..
00065 *     .. Intrinsic Functions ..
00066       INTRINSIC          AIMAG, CMPLX, REAL
00067 *     ..
00068 *     .. External Subroutines ..
00069       EXTERNAL           SGEMM
00070 *     ..
00071 *     .. Executable Statements ..
00072 *
00073 *     Quick return if possible.
00074 *
00075       IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) )
00076      $   RETURN
00077 *
00078       DO 20 J = 1, N
00079          DO 10 I = 1, M
00080             RWORK( ( J-1 )*M+I ) = REAL( B( I, J ) )
00081    10    CONTINUE
00082    20 CONTINUE
00083 *
00084       L = M*N + 1
00085       CALL SGEMM( 'N', 'N', M, N, M, ONE, A, LDA, RWORK, M, ZERO,
00086      $            RWORK( L ), M )
00087       DO 40 J = 1, N
00088          DO 30 I = 1, M
00089             C( I, J ) = RWORK( L+( J-1 )*M+I-1 )
00090    30    CONTINUE
00091    40 CONTINUE
00092 *
00093       DO 60 J = 1, N
00094          DO 50 I = 1, M
00095             RWORK( ( J-1 )*M+I ) = AIMAG( B( I, J ) )
00096    50    CONTINUE
00097    60 CONTINUE
00098       CALL SGEMM( 'N', 'N', M, N, M, ONE, A, LDA, RWORK, M, ZERO,
00099      $            RWORK( L ), M )
00100       DO 80 J = 1, N
00101          DO 70 I = 1, M
00102             C( I, J ) = CMPLX( REAL( C( I, J ) ),
00103      $                  RWORK( L+( J-1 )*M+I-1 ) )
00104    70    CONTINUE
00105    80 CONTINUE
00106 *
00107       RETURN
00108 *
00109 *     End of CLARCM
00110 *
00111       END