da/d19/clakf2_8f_source.html

00001       SUBROUTINE CLAKF2( M, N, A, LDA, B, D, E, Z, LDZ )
00002 *
00003 *  -- LAPACK test routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2006
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            LDA, LDZ, M, N
00009 *     ..
00010 *     .. Array Arguments ..
00011       COMPLEX            A( LDA, * ), B( LDA, * ), D( LDA, * ),
00012      $                   E( LDA, * ), Z( LDZ, * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  Form the 2*M*N by 2*M*N matrix
00019 *
00020 *         Z = [ kron(In, A)  -kron(B', Im) ]
00021 *             [ kron(In, D)  -kron(E', Im) ],
00022 *
00023 *  where In is the identity matrix of size n and X' is the transpose
00024 *  of X. kron(X, Y) is the Kronecker product between the matrices X
00025 *  and Y.
00026 *
00027 *  Arguments
00028 *  =========
00029 *
00030 *  M       (input) INTEGER
00031 *          Size of matrix, must be >= 1.
00032 *
00033 *  N       (input) INTEGER
00034 *          Size of matrix, must be >= 1.
00035 *
00036 *  A       (input) COMPLEX, dimension ( LDA, M )
00037 *          The matrix A in the output matrix Z.
00038 *
00039 *  LDA     (input) INTEGER
00040 *          The leading dimension of A, B, D, and E. ( LDA >= M+N )
00041 *
00042 *  B       (input) COMPLEX, dimension ( LDA, N )
00043 *  D       (input) COMPLEX, dimension ( LDA, M )
00044 *  E       (input) COMPLEX, dimension ( LDA, N )
00045 *          The matrices used in forming the output matrix Z.
00046 *
00047 *  Z       (output) COMPLEX, dimension ( LDZ, 2*M*N )
00048 *          The resultant Kronecker M*N*2 by M*N*2 matrix (see above.)
00049 *
00050 *  LDZ     (input) INTEGER
00051 *          The leading dimension of Z. ( LDZ >= 2*M*N )
00052 *
00053 *  ====================================================================
00054 *
00055 *     .. Parameters ..
00056       COMPLEX            ZERO
00057       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
00058 *     ..
00059 *     .. Local Scalars ..
00060       INTEGER            I, IK, J, JK, L, MN, MN2
00061 *     ..
00062 *     .. External Subroutines ..
00063       EXTERNAL           CLASET
00064 *     ..
00065 *     .. Executable Statements ..
00066 *
00067 *     Initialize Z
00068 *
00069       MN = M*N
00070       MN2 = 2*MN
00071       CALL CLASET( 'Full', MN2, MN2, ZERO, ZERO, Z, LDZ )
00072 *
00073       IK = 1
00074       DO 50 L = 1, N
00075 *
00076 *        form kron(In, A)
00077 *
00078          DO 20 I = 1, M
00079             DO 10 J = 1, M
00080                Z( IK+I-1, IK+J-1 ) = A( I, J )
00081    10       CONTINUE
00082    20    CONTINUE
00083 *
00084 *        form kron(In, D)
00085 *
00086          DO 40 I = 1, M
00087             DO 30 J = 1, M
00088                Z( IK+MN+I-1, IK+J-1 ) = D( I, J )
00089    30       CONTINUE
00090    40    CONTINUE
00091 *
00092          IK = IK + M
00093    50 CONTINUE
00094 *
00095       IK = 1
00096       DO 90 L = 1, N
00097          JK = MN + 1
00098 *
00099          DO 80 J = 1, N
00100 *
00101 *           form -kron(B', Im)
00102 *
00103             DO 60 I = 1, M
00104                Z( IK+I-1, JK+I-1 ) = -B( J, L )
00105    60       CONTINUE
00106 *
00107 *           form -kron(E', Im)
00108 *
00109             DO 70 I = 1, M
00110                Z( IK+MN+I-1, JK+I-1 ) = -E( J, L )
00111    70       CONTINUE
00112 *
00113             JK = JK + M
00114    80    CONTINUE
00115 *
00116          IK = IK + M
00117    90 CONTINUE
00118 *
00119       RETURN
00120 *
00121 *     End of CLAKF2
00122 *
00123       END