zlarcm.c
Go to the documentation of this file.
00001 /* zlarcm.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Table of constant values */
00017 
00018 static doublereal c_b6 = 1.;
00019 static doublereal c_b7 = 0.;
00020 
00021 /* Subroutine */ int zlarcm_(integer *m, integer *n, doublereal *a, integer *
00022         lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc, 
00023          doublereal *rwork)
00024 {
00025     /* System generated locals */
00026     integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2, 
00027             i__3, i__4, i__5;
00028     doublereal d__1;
00029     doublecomplex z__1;
00030 
00031     /* Builtin functions */
00032     double d_imag(doublecomplex *);
00033 
00034     /* Local variables */
00035     integer i__, j, l;
00036     extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *, 
00037             integer *, doublereal *, doublereal *, integer *, doublereal *, 
00038             integer *, doublereal *, doublereal *, integer *);
00039 
00040 
00041 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00042 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00043 /*     November 2006 */
00044 
00045 /*     .. Scalar Arguments .. */
00046 /*     .. */
00047 /*     .. Array Arguments .. */
00048 /*     .. */
00049 
00050 /*  Purpose */
00051 /*  ======= */
00052 
00053 /*  ZLARCM performs a very simple matrix-matrix multiplication: */
00054 /*           C := A * B, */
00055 /*  where A is M by M and real; B is M by N and complex; */
00056 /*  C is M by N and complex. */
00057 
00058 /*  Arguments */
00059 /*  ========= */
00060 
00061 /*  M       (input) INTEGER */
00062 /*          The number of rows of the matrix A and of the matrix C. */
00063 /*          M >= 0. */
00064 
00065 /*  N       (input) INTEGER */
00066 /*          The number of columns and rows of the matrix B and */
00067 /*          the number of columns of the matrix C. */
00068 /*          N >= 0. */
00069 
00070 /*  A       (input) DOUBLE PRECISION array, dimension (LDA, M) */
00071 /*          A contains the M by M matrix A. */
00072 
00073 /*  LDA     (input) INTEGER */
00074 /*          The leading dimension of the array A. LDA >=max(1,M). */
00075 
00076 /*  B       (input) DOUBLE PRECISION array, dimension (LDB, N) */
00077 /*          B contains the M by N matrix B. */
00078 
00079 /*  LDB     (input) INTEGER */
00080 /*          The leading dimension of the array B. LDB >=max(1,M). */
00081 
00082 /*  C       (input) COMPLEX*16 array, dimension (LDC, N) */
00083 /*          C contains the M by N matrix C. */
00084 
00085 /*  LDC     (input) INTEGER */
00086 /*          The leading dimension of the array C. LDC >=max(1,M). */
00087 
00088 /*  RWORK   (workspace) DOUBLE PRECISION array, dimension (2*M*N) */
00089 
00090 /*  ===================================================================== */
00091 
00092 /*     .. Parameters .. */
00093 /*     .. */
00094 /*     .. Local Scalars .. */
00095 /*     .. */
00096 /*     .. Intrinsic Functions .. */
00097 /*     .. */
00098 /*     .. External Subroutines .. */
00099 /*     .. */
00100 /*     .. Executable Statements .. */
00101 
00102 /*     Quick return if possible. */
00103 
00104     /* Parameter adjustments */
00105     a_dim1 = *lda;
00106     a_offset = 1 + a_dim1;
00107     a -= a_offset;
00108     b_dim1 = *ldb;
00109     b_offset = 1 + b_dim1;
00110     b -= b_offset;
00111     c_dim1 = *ldc;
00112     c_offset = 1 + c_dim1;
00113     c__ -= c_offset;
00114     --rwork;
00115 
00116     /* Function Body */
00117     if (*m == 0 || *n == 0) {
00118         return 0;
00119     }
00120 
00121     i__1 = *n;
00122     for (j = 1; j <= i__1; ++j) {
00123         i__2 = *m;
00124         for (i__ = 1; i__ <= i__2; ++i__) {
00125             i__3 = i__ + j * b_dim1;
00126             rwork[(j - 1) * *m + i__] = b[i__3].r;
00127 /* L10: */
00128         }
00129 /* L20: */
00130     }
00131 
00132     l = *m * *n + 1;
00133     dgemm_("N", "N", m, n, m, &c_b6, &a[a_offset], lda, &rwork[1], m, &c_b7, &
00134             rwork[l], m);
00135     i__1 = *n;
00136     for (j = 1; j <= i__1; ++j) {
00137         i__2 = *m;
00138         for (i__ = 1; i__ <= i__2; ++i__) {
00139             i__3 = i__ + j * c_dim1;
00140             i__4 = l + (j - 1) * *m + i__ - 1;
00141             c__[i__3].r = rwork[i__4], c__[i__3].i = 0.;
00142 /* L30: */
00143         }
00144 /* L40: */
00145     }
00146 
00147     i__1 = *n;
00148     for (j = 1; j <= i__1; ++j) {
00149         i__2 = *m;
00150         for (i__ = 1; i__ <= i__2; ++i__) {
00151             rwork[(j - 1) * *m + i__] = d_imag(&b[i__ + j * b_dim1]);
00152 /* L50: */
00153         }
00154 /* L60: */
00155     }
00156     dgemm_("N", "N", m, n, m, &c_b6, &a[a_offset], lda, &rwork[1], m, &c_b7, &
00157             rwork[l], m);
00158     i__1 = *n;
00159     for (j = 1; j <= i__1; ++j) {
00160         i__2 = *m;
00161         for (i__ = 1; i__ <= i__2; ++i__) {
00162             i__3 = i__ + j * c_dim1;
00163             i__4 = i__ + j * c_dim1;
00164             d__1 = c__[i__4].r;
00165             i__5 = l + (j - 1) * *m + i__ - 1;
00166             z__1.r = d__1, z__1.i = rwork[i__5];
00167             c__[i__3].r = z__1.r, c__[i__3].i = z__1.i;
00168 /* L70: */
00169         }
00170 /* L80: */
00171     }
00172 
00173     return 0;
00174 
00175 /*     End of ZLARCM */
00176 
00177 } /* zlarcm_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:41